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, 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 3324 of file ipshell.cc.

3325 {
3326  semicOK,
3328 
3331 
3338 
3343 
3349 
3352 
3355 
3356 } semicState;
semicState
Definition: ipshell.cc:3324

§ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3440 of file ipshell.cc.

Function Documentation

§ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3250 of file ipshell.cc.

3251 {
3252  spec.mu = (int)(long)(l->m[0].Data( ));
3253  spec.pg = (int)(long)(l->m[1].Data( ));
3254  spec.n = (int)(long)(l->m[2].Data( ));
3255 
3256  spec.copy_new( spec.n );
3257 
3258  intvec *num = (intvec*)l->m[3].Data( );
3259  intvec *den = (intvec*)l->m[4].Data( );
3260  intvec *mul = (intvec*)l->m[5].Data( );
3261 
3262  for( int i=0; i<spec.n; i++ )
3263  {
3264  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3265  spec.w[i] = (*mul)[i];
3266  }
3267 }
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:1138
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:996
Definition: intvec.h:14
ip_smatrix * matrix
leftv next
Definition: subexpr.h:87
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1138
Definition: tok.h:117

§ getList()

lists getList ( spectrum spec)

Definition at line 3286 of file ipshell.cc.

3287 {
3289 
3290  L->Init( 6 );
3291 
3292  intvec *num = new intvec( spec.n );
3293  intvec *den = new intvec( spec.n );
3294  intvec *mult = new intvec( spec.n );
3295 
3296  for( int i=0; i<spec.n; i++ )
3297  {
3298  (*num) [i] = spec.s[i].get_num_si( );
3299  (*den) [i] = spec.s[i].get_den_si( );
3300  (*mult)[i] = spec.w[i];
3301  }
3302 
3303  L->m[0].rtyp = INT_CMD; // milnor number
3304  L->m[1].rtyp = INT_CMD; // geometrical genus
3305  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3306  L->m[3].rtyp = INTVEC_CMD; // numerators
3307  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3308  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3309 
3310  L->m[0].data = (void*)(long)spec.mu;
3311  L->m[1].data = (void*)(long)spec.pg;
3312  L->m[2].data = (void*)(long)spec.n;
3313  L->m[3].data = (void*)num;
3314  L->m[4].data = (void*)den;
3315  L->m[5].data = (void*)mult;
3316 
3317  return L;
3318 }
#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:89
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:92
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 6301 of file ipshell.cc.

6302 {
6303  memset(res,0,sizeof(sleftv));
6304  res->rtyp=a->Typ();
6305  switch (res->rtyp /*a->Typ()*/)
6306  {
6307  case INTVEC_CMD:
6308  case INTMAT_CMD:
6309  return iiApplyINTVEC(res,a,op,proc);
6310  case BIGINTMAT_CMD:
6311  return iiApplyBIGINTMAT(res,a,op,proc);
6312  case IDEAL_CMD:
6313  case MODUL_CMD:
6314  case MATRIX_CMD:
6315  return iiApplyIDEAL(res,a,op,proc);
6316  case LIST_CMD:
6317  return iiApplyLIST(res,a,op,proc);
6318  }
6319  WerrorS("first argument to `apply` must allow an index");
6320  return TRUE;
6321 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:996
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6259
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6269
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6264
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6227

§ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6259 of file ipshell.cc.

6260 {
6261  WerrorS("not implemented");
6262  return TRUE;
6263 }
#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 6264 of file ipshell.cc.

6265 {
6266  WerrorS("not implemented");
6267  return TRUE;
6268 }
#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 6227 of file ipshell.cc.

6228 {
6229  intvec *aa=(intvec*)a->Data();
6230  sleftv tmp_out;
6231  sleftv tmp_in;
6232  leftv curr=res;
6233  BOOLEAN bo=FALSE;
6234  for(int i=0;i<aa->length(); i++)
6235  {
6236  memset(&tmp_in,0,sizeof(tmp_in));
6237  tmp_in.rtyp=INT_CMD;
6238  tmp_in.data=(void*)(long)(*aa)[i];
6239  if (proc==NULL)
6240  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6241  else
6242  bo=jjPROC(&tmp_out,proc,&tmp_in);
6243  if (bo)
6244  {
6245  res->CleanUp(currRing);
6246  Werror("apply fails at index %d",i+1);
6247  return TRUE;
6248  }
6249  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6250  else
6251  {
6252  curr->next=(leftv)omAllocBin(sleftv_bin);
6253  curr=curr->next;
6254  memcpy(curr,&tmp_out,sizeof(tmp_out));
6255  }
6256  }
6257  return FALSE;
6258 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8333
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1600
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:60
void * data
Definition: subexpr.h:89
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:87
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:86
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
void * Data()
Definition: subexpr.cc:1138
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 6269 of file ipshell.cc.

6270 {
6271  lists aa=(lists)a->Data();
6272  sleftv tmp_out;
6273  sleftv tmp_in;
6274  leftv curr=res;
6275  BOOLEAN bo=FALSE;
6276  for(int i=0;i<=aa->nr; i++)
6277  {
6278  memset(&tmp_in,0,sizeof(tmp_in));
6279  tmp_in.Copy(&(aa->m[i]));
6280  if (proc==NULL)
6281  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6282  else
6283  bo=jjPROC(&tmp_out,proc,&tmp_in);
6284  tmp_in.CleanUp();
6285  if (bo)
6286  {
6287  res->CleanUp(currRing);
6288  Werror("apply fails at index %d",i+1);
6289  return TRUE;
6290  }
6291  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6292  else
6293  {
6294  curr->next=(leftv)omAllocBin(sleftv_bin);
6295  curr=curr->next;
6296  memcpy(curr,&tmp_out,sizeof(tmp_out));
6297  }
6298  }
6299  return FALSE;
6300 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8333
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1600
#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:689
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
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:333
void * Data()
Definition: subexpr.cc:1138
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 6350 of file ipshell.cc.

6351 {
6352  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6353  // find end of s:
6354  int end_s=strlen(s);
6355  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6356  s[end_s+1]='\0';
6357  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6358  sprintf(name,"%s->%s",a,s);
6359  // find start of last expression
6360  int start_s=end_s-1;
6361  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6362  if (start_s<0) // ';' not found
6363  {
6364  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6365  }
6366  else // s[start_s] is ';'
6367  {
6368  s[start_s]='\0';
6369  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6370  }
6371  memset(r,0,sizeof(*r));
6372  // now produce procinfo for PROC_CMD:
6373  r->data = (void *)omAlloc0Bin(procinfo_bin);
6374  ((procinfo *)(r->data))->language=LANG_NONE;
6375  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6376  ((procinfo *)r->data)->data.s.body=ss;
6377  omFree(name);
6378  r->rtyp=PROC_CMD;
6379  //r->rtyp=STRING_CMD;
6380  //r->data=ss;
6381  return FALSE;
6382 }
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:883
#define omAlloc(size)
Definition: omAllocDecl.h:210
omBin procinfo_bin
Definition: subexpr.cc:51
void * data
Definition: subexpr.h:89
#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:92

§ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6384 of file ipshell.cc.

6385 {
6386  char* ring_name=omStrDup((char*)r->Name());
6387  int t=arg->Typ();
6388  if (t==RING_CMD)
6389  {
6390  sleftv tmp;
6391  memset(&tmp,0,sizeof(tmp));
6392  tmp.rtyp=IDHDL;
6393  tmp.data=(char*)rDefault(ring_name);
6394  if (tmp.data!=NULL)
6395  {
6396  BOOLEAN b=iiAssign(&tmp,arg);
6397  if (b) return TRUE;
6398  rSetHdl(ggetid(ring_name));
6399  omFree(ring_name);
6400  return FALSE;
6401  }
6402  else
6403  return TRUE;
6404  }
6405  else if (t==CRING_CMD)
6406  {
6407  sleftv tmp;
6408  sleftv n;
6409  memset(&n,0,sizeof(n));
6410  n.name=ring_name;
6411  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6412  if (iiAssign(&tmp,arg)) return TRUE;
6413  //Print("create %s\n",r->Name());
6414  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6415  return FALSE;
6416  }
6417  //Print("create %s\n",r->Name());
6418  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6419  return TRUE;// not handled -> error for now
6420 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:996
const char * Name()
Definition: subexpr.h:121
#define IDHDL
Definition: tok.h:31
idhdl rDefault(const char *s)
Definition: ipshell.cc:1519
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
Definition: tok.h:56
const char * name
Definition: subexpr.h:88
#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:92
void rSetHdl(idhdl h)
Definition: ipshell.cc:5002
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:496
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1793
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  ,
leftv  args 
)

Definition at line 1179 of file ipshell.cc.

1180 {
1181  // <string1...stringN>,<proc>
1182  // known: args!=NULL, l>=1
1183  int l=args->listLength();
1184  int ll=0;
1185  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1186  if (ll!=(l-1)) return FALSE;
1187  leftv h=args;
1188  short *t=(short*)omAlloc(l*sizeof(short));
1189  t[0]=l-1;
1190  int b;
1191  int i;
1192  for(i=1;i<l;i++,h=h->next)
1193  {
1194  if (h->Typ()!=STRING_CMD)
1195  {
1196  omFree(t);
1197  Werror("arg %d is not a string",i);
1198  return TRUE;
1199  }
1200  int tt;
1201  b=IsCmd((char *)h->Data(),tt);
1202  if(b) t[i]=tt;
1203  else
1204  {
1205  omFree(t);
1206  Werror("arg %d is not a type name",i);
1207  return TRUE;
1208  }
1209  }
1210  if (h->Typ()!=PROC_CMD)
1211  {
1212  omFree(t);
1213  Werror("last arg (%d) is not a proc",i);
1214  return TRUE;
1215  }
1216  b=iiCheckTypes(iiCurrArgs,t,0);
1217  omFree(t);
1218  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1219  {
1220  BOOLEAN err;
1221  //Print("branchTo: %s\n",h->Name());
1222  iiCurrProc=(idhdl)h->data;
1224  if( pi->data.s.body==NULL )
1225  {
1227  if (pi->data.s.body==NULL) return TRUE;
1228  }
1229  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1230  {
1231  currPack=pi->pack;
1234  //Print("set pack=%s\n",IDID(currPackHdl));
1235  }
1236  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1238  if (iiCurrArgs!=NULL)
1239  {
1240  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1241  iiCurrArgs->CleanUp();
1243  iiCurrArgs=NULL;
1244  }
1245  return 2-err;
1246  }
1247  return FALSE;
1248 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:115
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN exitBuffer(feBufferTypes typ)
Definition: fevoices.cc:241
#define IDHDL
Definition: tok.h:31
idhdl iiCurrProc
Definition: ipshell.cc:79
#define omFree(addr)
Definition: omAllocDecl.h:261
idrec * idhdl
Definition: ring.h:18
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:311
#define IDPROC(a)
Definition: ipid.h:137
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
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:6440
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:78
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
idhdl packFindHdl(package r)
Definition: ipid.cc:739
void iiCheckPack(package &p)
Definition: ipshell.cc:1505
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
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:8746
#define Warn
Definition: emacs.cc:80

§ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1505 of file ipshell.cc.

1506 {
1507  if (p!=basePack)
1508  {
1509  idhdl t=basePack->idroot;
1510  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1511  if (t==NULL)
1512  {
1513  WarnS("package not found\n");
1514  p=basePack;
1515  }
1516  }
1517 }
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 1461 of file ipshell.cc.

1462 {
1463  if (currRing==NULL)
1464  {
1465  #ifdef SIQ
1466  if (siq<=0)
1467  {
1468  #endif
1469  if (RingDependend(i))
1470  {
1471  WerrorS("no ring active");
1472  return TRUE;
1473  }
1474  #ifdef SIQ
1475  }
1476  #endif
1477  }
1478  return FALSE;
1479 }
#define FALSE
Definition: auxiliary.h:94
BOOLEAN siq
Definition: subexpr.cc:58
#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 6440 of file ipshell.cc.

6441 {
6442  if (args==NULL)
6443  {
6444  if (type_list[0]==0) return TRUE;
6445  else
6446  {
6447  if (report) WerrorS("no arguments expected");
6448  return FALSE;
6449  }
6450  }
6451  int l=args->listLength();
6452  if (l!=(int)type_list[0])
6453  {
6454  if (report) iiReportTypes(0,l,type_list);
6455  return FALSE;
6456  }
6457  for(int i=1;i<=l;i++,args=args->next)
6458  {
6459  short t=type_list[i];
6460  if (t!=ANY_TYPE)
6461  {
6462  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6463  || (t!=args->Typ()))
6464  {
6465  if (report) iiReportTypes(i,args->Typ(),type_list);
6466  return FALSE;
6467  }
6468  }
6469  }
6470  return TRUE;
6471 }
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:94
int listLength()
Definition: subexpr.cc:61
#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:6422
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#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:33
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:83
int yylineno
Definition: febase.cc:45
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
char * filename
Definition: fevoices.h:62
#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:89
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:259
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
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:87
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:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
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:83
Definition: attrib.h:15
#define FALSE
Definition: auxiliary.h:94
idhdl iiCurrProc
Definition: ipshell.cc:79
void * data
Definition: subexpr.h:89
void * CopyA()
Definition: subexpr.cc:1958
#define NULL
Definition: omList.c:10
attr attribute
Definition: idrec.h:41
int rtyp
Definition: subexpr.h:92
attr get(const char *s)
Definition: attrib.cc:96
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 1383 of file ipshell.cc.

1384 {
1385  BOOLEAN nok=FALSE;
1386  leftv r=v;
1387  while (v!=NULL)
1388  {
1389  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1390  {
1391  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1392  nok=TRUE;
1393  }
1394  else
1395  {
1396  if(iiInternalExport(v, toLev))
1397  {
1398  r->CleanUp();
1399  return TRUE;
1400  }
1401  }
1402  v=v->next;
1403  }
1404  r->CleanUp();
1405  return nok;
1406 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#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:88
leftv next
Definition: subexpr.h:87
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1285
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
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 1409 of file ipshell.cc.

1410 {
1411 // if ((pack==basePack)&&(pack!=currPack))
1412 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1413  BOOLEAN nok=FALSE;
1414  leftv rv=v;
1415  while (v!=NULL)
1416  {
1417  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1418  )
1419  {
1420  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1421  nok=TRUE;
1422  }
1423  else
1424  {
1425  idhdl old=pack->idroot->get( v->name,toLev);
1426  if (old!=NULL)
1427  {
1428  if ((pack==currPack) && (old==(idhdl)v->data))
1429  {
1430  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1431  break;
1432  }
1433  else if (IDTYP(old)==v->Typ())
1434  {
1435  if (BVERBOSE(V_REDEFINE))
1436  {
1437  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1438  }
1439  v->name=omStrDup(v->name);
1440  killhdl2(old,&(pack->idroot),currRing);
1441  }
1442  else
1443  {
1444  rv->CleanUp();
1445  return TRUE;
1446  }
1447  }
1448  //Print("iiExport: pack=%s\n",IDID(root));
1449  if(iiInternalExport(v, toLev, pack))
1450  {
1451  rv->CleanUp();
1452  return TRUE;
1453  }
1454  }
1455  v=v->next;
1456  }
1457  rv->CleanUp();
1458  return nok;
1459 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:996
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
void * data
Definition: subexpr.h:89
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:409
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
#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:1285
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
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 1481 of file ipshell.cc.

1482 {
1483  int i;
1484  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1485  poly po=NULL;
1487  {
1488  scComputeHC(I,currRing->qideal,ak,po);
1489  if (po!=NULL)
1490  {
1491  pGetCoeff(po)=nInit(1);
1492  for (i=rVar(currRing); i>0; i--)
1493  {
1494  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1495  }
1496  pSetComp(po,ak);
1497  pSetm(po);
1498  }
1499  }
1500  else
1501  po=pOne();
1502  return po;
1503 }
#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:161
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 rHasLocalOrMixedOrdering_currRing()
Definition: ring.h:757
#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 1285 of file ipshell.cc.

1286 {
1287  idhdl h=(idhdl)v->data;
1288  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1289  if (IDLEV(h)==0)
1290  {
1291  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1292  }
1293  else
1294  {
1295  h=IDROOT->get(v->name,toLev);
1296  idhdl *root=&IDROOT;
1297  if ((h==NULL)&&(currRing!=NULL))
1298  {
1299  h=currRing->idroot->get(v->name,toLev);
1300  root=&currRing->idroot;
1301  }
1302  BOOLEAN keepring=FALSE;
1303  if ((h!=NULL)&&(IDLEV(h)==toLev))
1304  {
1305  if (IDTYP(h)==v->Typ())
1306  {
1307  if ((IDTYP(h)==RING_CMD)
1308  && (v->Data()==IDDATA(h)))
1309  {
1310  IDRING(h)->ref++;
1311  keepring=TRUE;
1312  IDLEV(h)=toLev;
1313  //WarnS("keepring");
1314  return FALSE;
1315  }
1316  if (BVERBOSE(V_REDEFINE))
1317  {
1318  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1319  }
1320  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1321  killhdl2(h,root,currRing);
1322  }
1323  else
1324  {
1325  return TRUE;
1326  }
1327  }
1328  h=(idhdl)v->data;
1329  IDLEV(h)=toLev;
1330  if (keepring) IDRING(h)->ref--;
1332  //Print("export %s\n",IDID(h));
1333  }
1334  return FALSE;
1335 }
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:996
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
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:409
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
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:470
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
void * Data()
Definition: subexpr.cc:1138
#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 1337 of file ipshell.cc.

1338 {
1339  idhdl h=(idhdl)v->data;
1340  if(h==NULL)
1341  {
1342  Warn("'%s': no such identifier\n", v->name);
1343  return FALSE;
1344  }
1345  package frompack=v->req_packhdl;
1346  if (frompack==NULL) frompack=currPack;
1347  if ((RingDependend(IDTYP(h)))
1348  || ((IDTYP(h)==LIST_CMD)
1349  && (lRingDependend(IDLIST(h)))
1350  )
1351  )
1352  {
1353  //Print("// ==> Ringdependent set nesting to 0\n");
1354  return (iiInternalExport(v, toLev));
1355  }
1356  else
1357  {
1358  IDLEV(h)=toLev;
1359  v->req_packhdl=rootpack;
1360  if (h==frompack->idroot)
1361  {
1362  frompack->idroot=h->next;
1363  }
1364  else
1365  {
1366  idhdl hh=frompack->idroot;
1367  while ((hh!=NULL) && (hh->next!=h))
1368  hh=hh->next;
1369  if ((hh!=NULL) && (hh->next==h))
1370  hh->next=h->next;
1371  else
1372  {
1373  Werror("`%s` not found",v->Name());
1374  return TRUE;
1375  }
1376  }
1377  h->next=rootpack->idroot;
1378  rootpack->idroot=h;
1379  }
1380  return FALSE;
1381 }
#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:121
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
#define IDTYP(a)
Definition: ipid.h:116
int RingDependend(int t)
Definition: gentable.cc:23
const char * name
Definition: subexpr.h:88
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:1285
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
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:83
#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:89
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:259
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:90
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:83
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:91
void * data
Definition: subexpr.h:89
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:92
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 1249 of file ipshell.cc.

1250 {
1251  if (iiCurrArgs==NULL)
1252  {
1253  if (strcmp(p->name,"#")==0)
1254  return iiDefaultParameter(p);
1255  Werror("not enough arguments for proc %s",VoiceName());
1256  p->CleanUp();
1257  return TRUE;
1258  }
1259  leftv h=iiCurrArgs;
1260  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1261  BOOLEAN is_default_list=FALSE;
1262  if (strcmp(p->name,"#")==0)
1263  {
1264  is_default_list=TRUE;
1265  rest=NULL;
1266  }
1267  else
1268  {
1269  h->next=NULL;
1270  }
1271  BOOLEAN res=iiAssign(p,h);
1272  if (is_default_list)
1273  {
1274  iiCurrArgs=NULL;
1275  }
1276  else
1277  {
1278  iiCurrArgs=rest;
1279  }
1280  h->CleanUp();
1282  return res;
1283 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#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:88
omBin sleftv_bin
Definition: subexpr.cc:50
const char * VoiceName()
Definition: fevoices.cc:66
leftv next
Definition: subexpr.h:87
#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:333
#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:135
#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 6422 of file ipshell.cc.

6423 {
6424  char *buf=(char*)omAlloc(250);
6425  buf[0]='\0';
6426  if (nr==0)
6427  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6428  else
6429  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6430  for(int i=1;i<=T[0];i++)
6431  {
6432  strcat(buf,"`");
6433  strcat(buf,Tok2Cmdname(T[i]));
6434  strcat(buf,"`");
6435  if (i<T[0]) strcat(buf,",");
6436  }
6437  WerrorS(buf);
6438 }
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 6323 of file ipshell.cc.

6324 {
6325  // assume a: level
6326  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6327  {
6328  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6329  char assume_yylinebuf[80];
6330  strncpy(assume_yylinebuf,my_yylinebuf,79);
6331  int lev=(long)a->Data();
6332  int startlev=0;
6333  idhdl h=ggetid("assumeLevel");
6334  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6335  if(lev <=startlev)
6336  {
6337  BOOLEAN bo=b->Eval();
6338  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6339  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6340  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6341  }
6342  }
6343  b->CleanUp();
6344  a->CleanUp();
6345  return FALSE;
6346 }
int Eval()
Definition: subexpr.cc:1761
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:996
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:333
void * Data()
Definition: subexpr.cc:1138
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
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:496

§ 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;
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:83
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:401
const char sNoName[]
Definition: subexpr.cc:56
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:996
leftv next
Definition: subexpr.h:87
Definition: tok.h:116
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
void * Data()
Definition: subexpr.cc:1138
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:83
Definition: tok.h:95
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920
int Typ()
Definition: subexpr.cc:996
void * data
Definition: subexpr.h:89
int rtyp
Definition: subexpr.h:92
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
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
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:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
int i
Definition: cfEzgcd.cc:123
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1138
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:83
const poly a
Definition: syzextra.cc:212
Definition: attrib.h:15
Definition: lists.h:22
attr * Attribute()
Definition: subexpr.cc:1393
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920
int Typ()
Definition: subexpr.cc:996
void * data
Definition: subexpr.h:89
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:92
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1138
Definition: tok.h:117
attr attribute
Definition: subexpr.h:90
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 3237 of file ipshell.cc.

3238 {
3239  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3240  return (res->data==NULL);
3241 }
void * data
Definition: subexpr.h:89
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:1398
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1138

§ jjINT_S_TO_ID()

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

Definition at line 6166 of file ipshell.cc.

6167 {
6168  if (n==0) n=1;
6169  ideal l=idInit(n,1);
6170  int i;
6171  poly p;
6172  for(i=rVar(currRing);i>0;i--)
6173  {
6174  if (e[i]>0)
6175  {
6176  n--;
6177  p=pOne();
6178  pSetExp(p,i,1);
6179  pSetm(p);
6180  l->m[n]=p;
6181  if (n==0) break;
6182  }
6183  }
6184  res->data=(char*)l;
6185  setFlag(res,FLAG_STD);
6186  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6187 }
#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:89
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:89
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:135
#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:1138
ideal * resolvente
Definition: ideals.h:18

§ jjPROC()

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

Definition at line 1600 of file iparith.cc.

1601 {
1602  void *d;
1603  Subexpr e;
1604  int typ;
1605  BOOLEAN t=FALSE;
1606  idhdl tmp_proc=NULL;
1607  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1608  {
1609  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1610  tmp_proc->id="_auto";
1611  tmp_proc->typ=PROC_CMD;
1612  tmp_proc->data.pinf=(procinfo *)u->Data();
1613  tmp_proc->ref=1;
1614  d=u->data; u->data=(void *)tmp_proc;
1615  e=u->e; u->e=NULL;
1616  t=TRUE;
1617  typ=u->rtyp; u->rtyp=IDHDL;
1618  }
1619  BOOLEAN sl;
1620  if (u->req_packhdl==currPack)
1621  sl = iiMake_proc((idhdl)u->data,NULL,v);
1622  else
1623  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1624  if (t)
1625  {
1626  u->rtyp=typ;
1627  u->data=d;
1628  u->e=e;
1629  omFreeSize(tmp_proc,sizeof(idrec));
1630  }
1631  if (sl) return TRUE;
1632  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1633  iiRETURNEXPR.Init();
1634  return FALSE;
1635 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:471
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:108
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:89
BOOLEAN iiMake_proc(idhdl pn, package pack, sleftv *sl)
Definition: iplib.cc:501
short ref
Definition: idrec.h:46
idrec * idhdl
Definition: ring.h:18
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1138
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 3230 of file ipshell.cc.

3231 {
3232  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3233  (poly)w->CopyD(), currRing);
3234  return errorreported;
3235 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:317
void * data
Definition: subexpr.h:89
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:708

§ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6196 of file ipshell.cc.

6197 {
6198  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6199  ideal I=(ideal)u->Data();
6200  int i;
6201  int n=0;
6202  for(i=I->nrows*I->ncols-1;i>=0;i--)
6203  {
6204  int n0=pGetVariables(I->m[i],e);
6205  if (n0>n) n=n0;
6206  }
6207  jjINT_S_TO_ID(n,e,res);
6208  return FALSE;
6209 }
#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:6166
#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:1138
#define omAlloc0(size)
Definition: omAllocDecl.h:211

§ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6188 of file ipshell.cc.

6189 {
6190  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6191  int n=pGetVariables((poly)u->Data(),e);
6192  jjINT_S_TO_ID(n,e,res);
6193  return FALSE;
6194 }
#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:6166
#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:1138
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211

§ kGroebner()

ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 6121 of file ipshell.cc.

6122 {
6123  //test|=Sy_bit(OPT_PROT);
6124  idhdl save_ringhdl=currRingHdl;
6125  ideal resid;
6126  idhdl new_ring=NULL;
6127  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6128  {
6129  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
6130  new_ring=currRingHdl;
6132  }
6133  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6134  idhdl h=ggetid("groebner");
6135  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6136  u.name=IDID(h);
6137 
6138  sleftv res; memset(&res,0,sizeof(res));
6139  if(jjPROC(&res,&u,&v))
6140  {
6141  resid=kStd(F,Q,testHomog,NULL);
6142  }
6143  else
6144  {
6145  //printf("typ:%d\n",res.rtyp);
6146  resid=(ideal)(res.data);
6147  }
6148  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6149  if (new_ring!=NULL)
6150  {
6151  idhdl h=IDROOT;
6152  if (h==new_ring) IDROOT=h->next;
6153  else
6154  {
6155  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6156  if (h!=NULL) h->next=h->next->next;
6157  }
6158  if (h!=NULL) omFreeSize(h,sizeof(*h));
6159  }
6160  currRingHdl=save_ringhdl;
6161  u.CleanUp();
6162  v.CleanUp();
6163  return resid;
6164 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1600
#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:89
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:259
const char * name
Definition: subexpr.h:88
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:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
static Poly * h
Definition: janet.cc:978
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:496
#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:472
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:471
#define TRUE
Definition: auxiliary.h:98
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:322
int Typ()
Definition: subexpr.cc:996
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
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:1564
#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:409
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:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void * data
Definition: subexpr.h:89
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:92
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:409
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 3213 of file ipshell.cc.

3214 {
3215  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3216  if (res->data==NULL)
3217  res->data=(char *)new intvec(rVar(currRing));
3218  return FALSE;
3219 }
#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:89
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:1138

§ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3191 of file ipshell.cc.

3192 {
3193  ideal F=(ideal)id->Data();
3194  intvec * iv = new intvec(rVar(currRing));
3195  polyset s;
3196  int sl, n, i;
3197  int *x;
3198 
3199  res->data=(char *)iv;
3200  s = F->m;
3201  sl = IDELEMS(F) - 1;
3202  n = rVar(currRing);
3203  double wNsqr = (double)2.0 / (double)n;
3205  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3206  wCall(s, sl, x, wNsqr, currRing);
3207  for (i = n; i!=0; i--)
3208  (*iv)[i-1] = x[i + n + 1];
3209  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3210  return FALSE;
3211 }
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:89
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:1138
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:21
#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:6211
#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 }
#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
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:496

§ list_error()

void list_error ( semicState  state)

Definition at line 3358 of file ipshell.cc.

3359 {
3360  switch( state )
3361  {
3362  case semicListTooShort:
3363  WerrorS( "the list is too short" );
3364  break;
3365  case semicListTooLong:
3366  WerrorS( "the list is too long" );
3367  break;
3368 
3370  WerrorS( "first element of the list should be int" );
3371  break;
3373  WerrorS( "second element of the list should be int" );
3374  break;
3376  WerrorS( "third element of the list should be int" );
3377  break;
3379  WerrorS( "fourth element of the list should be intvec" );
3380  break;
3382  WerrorS( "fifth element of the list should be intvec" );
3383  break;
3385  WerrorS( "sixth element of the list should be intvec" );
3386  break;
3387 
3388  case semicListNNegative:
3389  WerrorS( "first element of the list should be positive" );
3390  break;
3392  WerrorS( "wrong number of numerators" );
3393  break;
3395  WerrorS( "wrong number of denominators" );
3396  break;
3398  WerrorS( "wrong number of multiplicities" );
3399  break;
3400 
3401  case semicListMuNegative:
3402  WerrorS( "the Milnor number should be positive" );
3403  break;
3404  case semicListPgNegative:
3405  WerrorS( "the geometrical genus should be nonnegative" );
3406  break;
3407  case semicListNumNegative:
3408  WerrorS( "all numerators should be positive" );
3409  break;
3410  case semicListDenNegative:
3411  WerrorS( "all denominators should be positive" );
3412  break;
3413  case semicListMulNegative:
3414  WerrorS( "all multiplicities should be positive" );
3415  break;
3416 
3417  case semicListNotSymmetric:
3418  WerrorS( "it is not symmetric" );
3419  break;
3421  WerrorS( "it is not monotonous" );
3422  break;
3423 
3424  case semicListMilnorWrong:
3425  WerrorS( "the Milnor number is wrong" );
3426  break;
3427  case semicListPGWrong:
3428  WerrorS( "the geometrical genus is wrong" );
3429  break;
3430 
3431  default:
3432  WerrorS( "unspecific error" );
3433  break;
3434  }
3435 }
void WerrorS(const char *s)
Definition: feFopen.cc:24

§ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4143 of file ipshell.cc.

4144 {
4145  // -------------------
4146  // check list length
4147  // -------------------
4148 
4149  if( l->nr < 5 )
4150  {
4151  return semicListTooShort;
4152  }
4153  else if( l->nr > 5 )
4154  {
4155  return semicListTooLong;
4156  }
4157 
4158  // -------------
4159  // check types
4160  // -------------
4161 
4162  if( l->m[0].rtyp != INT_CMD )
4163  {
4165  }
4166  else if( l->m[1].rtyp != INT_CMD )
4167  {
4169  }
4170  else if( l->m[2].rtyp != INT_CMD )
4171  {
4173  }
4174  else if( l->m[3].rtyp != INTVEC_CMD )
4175  {
4177  }
4178  else if( l->m[4].rtyp != INTVEC_CMD )
4179  {
4181  }
4182  else if( l->m[5].rtyp != INTVEC_CMD )
4183  {
4185  }
4186 
4187  // -------------------------
4188  // check number of entries
4189  // -------------------------
4190 
4191  int mu = (int)(long)(l->m[0].Data( ));
4192  int pg = (int)(long)(l->m[1].Data( ));
4193  int n = (int)(long)(l->m[2].Data( ));
4194 
4195  if( n <= 0 )
4196  {
4197  return semicListNNegative;
4198  }
4199 
4200  intvec *num = (intvec*)l->m[3].Data( );
4201  intvec *den = (intvec*)l->m[4].Data( );
4202  intvec *mul = (intvec*)l->m[5].Data( );
4203 
4204  if( n != num->length( ) )
4205  {
4207  }
4208  else if( n != den->length( ) )
4209  {
4211  }
4212  else if( n != mul->length( ) )
4213  {
4215  }
4216 
4217  // --------
4218  // values
4219  // --------
4220 
4221  if( mu <= 0 )
4222  {
4223  return semicListMuNegative;
4224  }
4225  if( pg < 0 )
4226  {
4227  return semicListPgNegative;
4228  }
4229 
4230  int i;
4231 
4232  for( i=0; i<n; i++ )
4233  {
4234  if( (*num)[i] <= 0 )
4235  {
4236  return semicListNumNegative;
4237  }
4238  if( (*den)[i] <= 0 )
4239  {
4240  return semicListDenNegative;
4241  }
4242  if( (*mul)[i] <= 0 )
4243  {
4244  return semicListMulNegative;
4245  }
4246  }
4247 
4248  // ----------------
4249  // check symmetry
4250  // ----------------
4251 
4252  int j;
4253 
4254  for( i=0, j=n-1; i<=j; i++,j-- )
4255  {
4256  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4257  (*den)[i] != (*den)[j] ||
4258  (*mul)[i] != (*mul)[j] )
4259  {
4260  return semicListNotSymmetric;
4261  }
4262  }
4263 
4264  // ----------------
4265  // check monotony
4266  // ----------------
4267 
4268  for( i=0, j=1; i<n/2; i++,j++ )
4269  {
4270  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4271  {
4272  return semicListNotMonotonous;
4273  }
4274  }
4275 
4276  // ---------------------
4277  // check Milnor number
4278  // ---------------------
4279 
4280  for( mu=0, i=0; i<n; i++ )
4281  {
4282  mu += (*mul)[i];
4283  }
4284 
4285  if( mu != (int)(long)(l->m[0].Data( )) )
4286  {
4287  return semicListMilnorWrong;
4288  }
4289 
4290  // -------------------------
4291  // check geometrical genus
4292  // -------------------------
4293 
4294  for( pg=0, i=0; i<n; i++ )
4295  {
4296  if( (*num)[i]<=(*den)[i] )
4297  {
4298  pg += (*mul)[i];
4299  }
4300  }
4301 
4302  if( pg != (int)(long)(l->m[1].Data( )) )
4303  {
4304  return semicListPGWrong;
4305  }
4306 
4307  return semicOK;
4308 }
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:92
void * Data()
Definition: subexpr.cc:1138

§ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 4955 of file ipshell.cc.

4956 {
4957  int i,j;
4958  int count= self->roots[0]->getAnzRoots(); // number of roots
4959  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
4960 
4961  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
4962 
4963  if ( self->found_roots )
4964  {
4965  listofroots->Init( count );
4966 
4967  for (i=0; i < count; i++)
4968  {
4969  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
4970  onepoint->Init(elem);
4971  for ( j= 0; j < elem; j++ )
4972  {
4973  if ( !rField_is_long_C(currRing) )
4974  {
4975  onepoint->m[j].rtyp=STRING_CMD;
4976  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
4977  }
4978  else
4979  {
4980  onepoint->m[j].rtyp=NUMBER_CMD;
4981  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
4982  }
4983  onepoint->m[j].next= NULL;
4984  onepoint->m[j].name= NULL;
4985  }
4986  listofroots->m[i].rtyp=LIST_CMD;
4987  listofroots->m[i].data=(void *)onepoint;
4988  listofroots->m[j].next= NULL;
4989  listofroots->m[j].name= NULL;
4990  }
4991 
4992  }
4993  else
4994  {
4995  listofroots->Init( 0 );
4996  }
4997 
4998  return listofroots;
4999 }
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:89
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:88
int i
Definition: cfEzgcd.cc:123
bool found_roots
Definition: mpr_numeric.h:172
leftv next
Definition: subexpr.h:87
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:92
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 4453 of file ipshell.cc.

4454 {
4455  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4456  return FALSE;
4457 }
#define FALSE
Definition: auxiliary.h:94
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
void * data
Definition: subexpr.h:89
void * Data()
Definition: subexpr.cc:1138

§ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4459 of file ipshell.cc.

4460 {
4461  if ( !(rField_is_long_R(currRing)) )
4462  {
4463  WerrorS("Ground field not implemented!");
4464  return TRUE;
4465  }
4466 
4467  simplex * LP;
4468  matrix m;
4469 
4470  leftv v= args;
4471  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4472  return TRUE;
4473  else
4474  m= (matrix)(v->CopyD());
4475 
4476  LP = new simplex(MATROWS(m),MATCOLS(m));
4477  LP->mapFromMatrix(m);
4478 
4479  v= v->next;
4480  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4481  return TRUE;
4482  else
4483  LP->m= (int)(long)(v->Data());
4484 
4485  v= v->next;
4486  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4487  return TRUE;
4488  else
4489  LP->n= (int)(long)(v->Data());
4490 
4491  v= v->next;
4492  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4493  return TRUE;
4494  else
4495  LP->m1= (int)(long)(v->Data());
4496 
4497  v= v->next;
4498  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4499  return TRUE;
4500  else
4501  LP->m2= (int)(long)(v->Data());
4502 
4503  v= v->next;
4504  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4505  return TRUE;
4506  else
4507  LP->m3= (int)(long)(v->Data());
4508 
4509 #ifdef mprDEBUG_PROT
4510  Print("m (constraints) %d\n",LP->m);
4511  Print("n (columns) %d\n",LP->n);
4512  Print("m1 (<=) %d\n",LP->m1);
4513  Print("m2 (>=) %d\n",LP->m2);
4514  Print("m3 (==) %d\n",LP->m3);
4515 #endif
4516 
4517  LP->compute();
4518 
4519  lists lres= (lists)omAlloc( sizeof(slists) );
4520  lres->Init( 6 );
4521 
4522  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4523  lres->m[0].data=(void*)LP->mapToMatrix(m);
4524 
4525  lres->m[1].rtyp= INT_CMD; // found a solution?
4526  lres->m[1].data=(void*)(long)LP->icase;
4527 
4528  lres->m[2].rtyp= INTVEC_CMD;
4529  lres->m[2].data=(void*)LP->posvToIV();
4530 
4531  lres->m[3].rtyp= INTVEC_CMD;
4532  lres->m[3].data=(void*)LP->zrovToIV();
4533 
4534  lres->m[4].rtyp= INT_CMD;
4535  lres->m[4].data=(void*)(long)LP->m;
4536 
4537  lres->m[5].rtyp= INT_CMD;
4538  lres->m[5].data=(void*)(long)LP->n;
4539 
4540  res->data= (void*)lres;
4541 
4542  return FALSE;
4543 }
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
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:996
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
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:87
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:92
void * Data()
Definition: subexpr.cc:1138
#define MATROWS(i)
Definition: matpol.h:27
int icase
Definition: mpr_numeric.h:201
void * CopyD(int t)
Definition: subexpr.cc:708

§ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2961 of file ipshell.cc.

2962 {
2963  int i,j;
2964  matrix result;
2965  ideal id=(ideal)a->Data();
2966 
2967  result =mpNew(IDELEMS(id),rVar(currRing));
2968  for (i=1; i<=IDELEMS(id); i++)
2969  {
2970  for (j=1; j<=rVar(currRing); j++)
2971  {
2972  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2973  }
2974  }
2975  res->data=(char *)result;
2976  return FALSE;
2977 }
#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:89
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:47
void * Data()
Definition: subexpr.cc:1138
#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 2983 of file ipshell.cc.

2984 {
2985  int n=(int)(long)b->Data();
2986  int d=(int)(long)c->Data();
2987  int k,l,sign,row,col;
2988  matrix result;
2989  ideal temp;
2990  BOOLEAN bo;
2991  poly p;
2992 
2993  if ((d>n) || (d<1) || (n<1))
2994  {
2995  res->data=(char *)mpNew(1,1);
2996  return FALSE;
2997  }
2998  int *choise = (int*)omAlloc(d*sizeof(int));
2999  if (id==NULL)
3000  temp=idMaxIdeal(1);
3001  else
3002  temp=(ideal)id->Data();
3003 
3004  k = binom(n,d);
3005  l = k*d;
3006  l /= n-d+1;
3007  result =mpNew(l,k);
3008  col = 1;
3009  idInitChoise(d,1,n,&bo,choise);
3010  while (!bo)
3011  {
3012  sign = 1;
3013  for (l=1;l<=d;l++)
3014  {
3015  if (choise[l-1]<=IDELEMS(temp))
3016  {
3017  p = pCopy(temp->m[choise[l-1]-1]);
3018  if (sign == -1) p = pNeg(p);
3019  sign *= -1;
3020  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3021  MATELEM(result,row,col) = p;
3022  }
3023  }
3024  col++;
3025  idGetNextChoise(d,n,&bo,choise);
3026  }
3027  if (id==NULL) idDelete(&temp);
3028 
3029  res->data=(char *)result;
3030  return FALSE;
3031 }
#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 pNeg(p)
Definition: polys.h:181
int k
Definition: cfEzgcd.cc:93
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
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:47
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1138
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:3328
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 4568 of file ipshell.cc.

4569 {
4570 
4571  poly gls;
4572  gls= (poly)(arg1->Data());
4573  int howclean= (int)(long)arg3->Data();
4574 
4575  if ( !(rField_is_R(currRing) ||
4576  rField_is_Q(currRing) ||
4579  {
4580  WerrorS("Ground field not implemented!");
4581  return TRUE;
4582  }
4583 
4586  {
4587  unsigned long int ii = (unsigned long int)arg2->Data();
4588  setGMPFloatDigits( ii, ii );
4589  }
4590 
4591  if ( gls == NULL || pIsConstant( gls ) )
4592  {
4593  WerrorS("Input polynomial is constant!");
4594  return TRUE;
4595  }
4596 
4597  int ldummy;
4598  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4599  int i,vpos=0;
4600  poly piter;
4601  lists elist;
4602  lists rlist;
4603 
4604  elist= (lists)omAlloc( sizeof(slists) );
4605  elist->Init( 0 );
4606 
4607  if ( rVar(currRing) > 1 )
4608  {
4609  piter= gls;
4610  for ( i= 1; i <= rVar(currRing); i++ )
4611  if ( pGetExp( piter, i ) )
4612  {
4613  vpos= i;
4614  break;
4615  }
4616  while ( piter )
4617  {
4618  for ( i= 1; i <= rVar(currRing); i++ )
4619  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4620  {
4621  WerrorS("The input polynomial must be univariate!");
4622  return TRUE;
4623  }
4624  pIter( piter );
4625  }
4626  }
4627 
4628  rootContainer * roots= new rootContainer();
4629  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4630  piter= gls;
4631  for ( i= deg; i >= 0; i-- )
4632  {
4633  if ( piter && pTotaldegree(piter) == i )
4634  {
4635  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4636  //nPrint( pcoeffs[i] );PrintS(" ");
4637  pIter( piter );
4638  }
4639  else
4640  {
4641  pcoeffs[i]= nInit(0);
4642  }
4643  }
4644 
4645 #ifdef mprDEBUG_PROT
4646  for (i=deg; i >= 0; i--)
4647  {
4648  nPrint( pcoeffs[i] );PrintS(" ");
4649  }
4650  PrintLn();
4651 #endif
4652 
4653  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4654  roots->solver( howclean );
4655 
4656  int elem= roots->getAnzRoots();
4657  char *dummy;
4658  int j;
4659 
4660  rlist= (lists)omAlloc( sizeof(slists) );
4661  rlist->Init( elem );
4662 
4664  {
4665  for ( j= 0; j < elem; j++ )
4666  {
4667  rlist->m[j].rtyp=NUMBER_CMD;
4668  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4669  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4670  }
4671  }
4672  else
4673  {
4674  for ( j= 0; j < elem; j++ )
4675  {
4676  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4677  rlist->m[j].rtyp=STRING_CMD;
4678  rlist->m[j].data=(void *)dummy;
4679  }
4680  }
4681 
4682  elist->Clean();
4683  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4684 
4685  // this is (via fillContainer) the same data as in root
4686  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4687  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4688 
4689  delete roots;
4690 
4691  res->rtyp= LIST_CMD;
4692  res->data= (void*)rlist;
4693 
4694  return FALSE;
4695 }
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:89
#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:92
#define nCopy(n)
Definition: numbers.h:15
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1138
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 4545 of file ipshell.cc.

4546 {
4547  ideal gls = (ideal)(arg1->Data());
4548  int imtype= (int)(long)arg2->Data();
4549 
4550  uResultant::resMatType mtype= determineMType( imtype );
4551 
4552  // check input ideal ( = polynomial system )
4553  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4554  {
4555  return TRUE;
4556  }
4557 
4558  uResultant *resMat= new uResultant( gls, mtype, false );
4559  if (resMat!=NULL)
4560  {
4561  res->rtyp = MODUL_CMD;
4562  res->data= (void*)resMat->accessResMat()->getMatrix();
4563  if (!errorreported) delete resMat;
4564  }
4565  return errorreported;
4566 }
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:121
Definition: mpr_base.h:98
void * data
Definition: subexpr.h:89
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:92
void * Data()
Definition: subexpr.cc:1138

§ 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 4798 of file ipshell.cc.

4799 {
4800  leftv v= args;
4801 
4802  ideal gls;
4803  int imtype;
4804  int howclean;
4805 
4806  // get ideal
4807  if ( v->Typ() != IDEAL_CMD )
4808  return TRUE;
4809  else gls= (ideal)(v->Data());
4810  v= v->next;
4811 
4812  // get resultant matrix type to use (0,1)
4813  if ( v->Typ() != INT_CMD )
4814  return TRUE;
4815  else imtype= (int)(long)v->Data();
4816  v= v->next;
4817 
4818  if (imtype==0)
4819  {
4820  ideal test_id=idInit(1,1);
4821  int j;
4822  for(j=IDELEMS(gls)-1;j>=0;j--)
4823  {
4824  if (gls->m[j]!=NULL)
4825  {
4826  test_id->m[0]=gls->m[j];
4827  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4828  if (dummy_w!=NULL)
4829  {
4830  WerrorS("Newton polytope not of expected dimension");
4831  delete dummy_w;
4832  return TRUE;
4833  }
4834  }
4835  }
4836  }
4837 
4838  // get and set precision in digits ( > 0 )
4839  if ( v->Typ() != INT_CMD )
4840  return TRUE;
4841  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4843  {
4844  unsigned long int ii=(unsigned long int)v->Data();
4845  setGMPFloatDigits( ii, ii );
4846  }
4847  v= v->next;
4848 
4849  // get interpolation steps (0,1,2)
4850  if ( v->Typ() != INT_CMD )
4851  return TRUE;
4852  else howclean= (int)(long)v->Data();
4853 
4854  uResultant::resMatType mtype= determineMType( imtype );
4855  int i,count;
4856  lists listofroots= NULL;
4857  number smv= NULL;
4858  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4859 
4860  //emptylist= (lists)omAlloc( sizeof(slists) );
4861  //emptylist->Init( 0 );
4862 
4863  //res->rtyp = LIST_CMD;
4864  //res->data= (void *)emptylist;
4865 
4866  // check input ideal ( = polynomial system )
4867  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4868  {
4869  return TRUE;
4870  }
4871 
4872  uResultant * ures;
4873  rootContainer ** iproots;
4874  rootContainer ** muiproots;
4875  rootArranger * arranger;
4876 
4877  // main task 1: setup of resultant matrix
4878  ures= new uResultant( gls, mtype );
4879  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4880  {
4881  WerrorS("Error occurred during matrix setup!");
4882  return TRUE;
4883  }
4884 
4885  // if dense resultant, check if minor nonsingular
4886  if ( mtype == uResultant::denseResMat )
4887  {
4888  smv= ures->accessResMat()->getSubDet();
4889 #ifdef mprDEBUG_PROT
4890  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4891 #endif
4892  if ( nIsZero(smv) )
4893  {
4894  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4895  return TRUE;
4896  }
4897  }
4898 
4899  // main task 2: Interpolate specialized resultant polynomials
4900  if ( interpolate_det )
4901  iproots= ures->interpolateDenseSP( false, smv );
4902  else
4903  iproots= ures->specializeInU( false, smv );
4904 
4905  // main task 3: Interpolate specialized resultant polynomials
4906  if ( interpolate_det )
4907  muiproots= ures->interpolateDenseSP( true, smv );
4908  else
4909  muiproots= ures->specializeInU( true, smv );
4910 
4911 #ifdef mprDEBUG_PROT
4912  int c= iproots[0]->getAnzElems();
4913  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4914  c= muiproots[0]->getAnzElems();
4915  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4916 #endif
4917 
4918  // main task 4: Compute roots of specialized polys and match them up
4919  arranger= new rootArranger( iproots, muiproots, howclean );
4920  arranger->solve_all();
4921 
4922  // get list of roots
4923  if ( arranger->success() )
4924  {
4925  arranger->arrange();
4926  listofroots= listOfRoots(arranger, gmp_output_digits );
4927  }
4928  else
4929  {
4930  WerrorS("Solver was unable to find any roots!");
4931  return TRUE;
4932  }
4933 
4934  // free everything
4935  count= iproots[0]->getAnzElems();
4936  for (i=0; i < count; i++) delete iproots[i];
4937  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4938  count= muiproots[0]->getAnzElems();
4939  for (i=0; i < count; i++) delete muiproots[i];
4940  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4941 
4942  delete ures;
4943  delete arranger;
4944  nDelete( &smv );
4945 
4946  res->data= (void *)listofroots;
4947 
4948  //emptylist->Clean();
4949  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4950 
4951  return FALSE;
4952 }
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:83
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:996
const char * Name()
Definition: subexpr.h:121
Definition: mpr_base.h:98
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:89
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:87
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:1138
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:4955
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 4697 of file ipshell.cc.

4698 {
4699  int i;
4700  ideal p,w;
4701  p= (ideal)arg1->Data();
4702  w= (ideal)arg2->Data();
4703 
4704  // w[0] = f(p^0)
4705  // w[1] = f(p^1)
4706  // ...
4707  // p can be a vector of numbers (multivariate polynom)
4708  // or one number (univariate polynom)
4709  // tdg = deg(f)
4710 
4711  int n= IDELEMS( p );
4712  int m= IDELEMS( w );
4713  int tdg= (int)(long)arg3->Data();
4714 
4715  res->data= (void*)NULL;
4716 
4717  // check the input
4718  if ( tdg < 1 )
4719  {
4720  WerrorS("Last input parameter must be > 0!");
4721  return TRUE;
4722  }
4723  if ( n != rVar(currRing) )
4724  {
4725  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4726  return TRUE;
4727  }
4728  if ( m != (int)pow((double)tdg+1,(double)n) )
4729  {
4730  Werror("Size of second input ideal must be equal to %d!",
4731  (int)pow((double)tdg+1,(double)n));
4732  return TRUE;
4733  }
4734  if ( !(rField_is_Q(currRing) /* ||
4735  rField_is_R() || rField_is_long_R() ||
4736  rField_is_long_C()*/ ) )
4737  {
4738  WerrorS("Ground field not implemented!");
4739  return TRUE;
4740  }
4741 
4742  number tmp;
4743  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4744  for ( i= 0; i < n; i++ )
4745  {
4746  pevpoint[i]=nInit(0);
4747  if ( (p->m)[i] )
4748  {
4749  tmp = pGetCoeff( (p->m)[i] );
4750  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4751  {
4752  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4753  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4754  return TRUE;
4755  }
4756  } else tmp= NULL;
4757  if ( !nIsZero(tmp) )
4758  {
4759  if ( !pIsConstant((p->m)[i]))
4760  {
4761  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4762  WerrorS("Elements of first input ideal must be numbers!");
4763  return TRUE;
4764  }
4765  pevpoint[i]= nCopy( tmp );
4766  }
4767  }
4768 
4769  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4770  for ( i= 0; i < m; i++ )
4771  {
4772  wresults[i]= nInit(0);
4773  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4774  {
4775  if ( !pIsConstant((w->m)[i]))
4776  {
4777  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4778  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4779  WerrorS("Elements of second input ideal must be numbers!");
4780  return TRUE;
4781  }
4782  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4783  }
4784  }
4785 
4786  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4787  number *ncpoly= vm.interpolateDense( wresults );
4788  // do not free ncpoly[]!!
4789  poly rpoly= vm.numvec2poly( ncpoly );
4790 
4791  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4792  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4793 
4794  res->data= (void*)rpoly;
4795  return FALSE;
4796 }
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:89
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:1138
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 6211 of file ipshell.cc.

6212 {
6213  Print(" %s (",n);
6214  switch (p->language)
6215  {
6216  case LANG_SINGULAR: PrintS("S"); break;
6217  case LANG_C: PrintS("C"); break;
6218  case LANG_TOP: PrintS("T"); break;
6219  case LANG_NONE: PrintS("N"); break;
6220  default: PrintS("U");
6221  }
6222  if(p->libname!=NULL)
6223  Print(",%s", p->libname);
6224  PrintS(")");
6225 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
Definition: subexpr.h:21
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 2695 of file ipshell.cc.

2696 {
2697  if ((L->nr!=3)
2698 #ifdef HAVE_PLURAL
2699  &&(L->nr!=5)
2700 #endif
2701  )
2702  return NULL;
2703  int is_gf_char=0;
2704  // 0: char/ cf - ring
2705  // 1: list (var)
2706  // 2: list (ord)
2707  // 3: qideal
2708  // possibly:
2709  // 4: C
2710  // 5: D
2711 
2712  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2713 
2714  // ------------------------------------------------------------------
2715  // 0: char:
2716  if (L->m[0].Typ()==CRING_CMD)
2717  {
2718  R->cf=(coeffs)L->m[0].Data();
2719  R->cf->ref++;
2720  }
2721  else
2722  if (L->m[0].Typ()==INT_CMD)
2723  {
2724  int ch = (int)(long)L->m[0].Data();
2725  assume( ch >= 0 );
2726 
2727  if (ch == 0) // Q?
2728  R->cf = nInitChar(n_Q, NULL);
2729  else
2730  {
2731  int l = IsPrime(ch); // Zp?
2732  if( l != ch )
2733  {
2734  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2735  ch = l;
2736  }
2737  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2738  }
2739  }
2740  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2741  {
2742  lists LL=(lists)L->m[0].Data();
2743 
2744 #ifdef HAVE_RINGS
2745  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2746  {
2747  rComposeRing(LL, R); // Ring!?
2748  }
2749  else
2750 #endif
2751  if (LL->nr < 3)
2752  rComposeC(LL,R); // R, long_R, long_C
2753  else
2754  {
2755  if (LL->m[0].Typ()==INT_CMD)
2756  {
2757  int ch = (int)(long)LL->m[0].Data();
2758  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2759  if (fftable[is_gf_char]==0) is_gf_char=-1;
2760 
2761  if(is_gf_char!= -1)
2762  {
2763  GFInfo param;
2764 
2765  param.GFChar = ch;
2766  param.GFDegree = 1;
2767  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2768 
2769  // nfInitChar should be able to handle the case when ch is in fftables!
2770  R->cf = nInitChar(n_GF, (void*)&param);
2771  }
2772  }
2773 
2774  if( R->cf == NULL )
2775  {
2776  ring extRing = rCompose((lists)L->m[0].Data(),FALSE);
2777 
2778  if (extRing==NULL)
2779  {
2780  WerrorS("could not create the specified coefficient field");
2781  goto rCompose_err;
2782  }
2783 
2784  if( extRing->qideal != NULL ) // Algebraic extension
2785  {
2786  AlgExtInfo extParam;
2787 
2788  extParam.r = extRing;
2789 
2790  R->cf = nInitChar(n_algExt, (void*)&extParam);
2791  }
2792  else // Transcendental extension
2793  {
2794  TransExtInfo extParam;
2795  extParam.r = extRing;
2796  assume( extRing->qideal == NULL );
2797 
2798  R->cf = nInitChar(n_transExt, &extParam);
2799  }
2800  }
2801  }
2802  }
2803  else
2804  {
2805  WerrorS("coefficient field must be described by `int` or `list`");
2806  goto rCompose_err;
2807  }
2808 
2809  if( R->cf == NULL )
2810  {
2811  WerrorS("could not create coefficient field described by the input!");
2812  goto rCompose_err;
2813  }
2814 
2815  // ------------------------- VARS ---------------------------
2816  if (rComposeVar(L,R)) goto rCompose_err;
2817  // ------------------------ ORDER ------------------------------
2818  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2819 
2820  // ------------------------ ??????? --------------------
2821 
2822  rRenameVars(R);
2823  rComplete(R);
2824 
2825  // ------------------------ Q-IDEAL ------------------------
2826 
2827  if (L->m[3].Typ()==IDEAL_CMD)
2828  {
2829  ideal q=(ideal)L->m[3].Data();
2830  if (q->m[0]!=NULL)
2831  {
2832  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2833  {
2834  #if 0
2835  WerrorS("coefficient fields must be equal if q-ideal !=0");
2836  goto rCompose_err;
2837  #else
2838  ring orig_ring=currRing;
2839  rChangeCurrRing(R);
2840  int *perm=NULL;
2841  int *par_perm=NULL;
2842  int par_perm_size=0;
2843  nMapFunc nMap;
2844 
2845  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2846  {
2847  if (rEqual(orig_ring,currRing))
2848  {
2849  nMap=n_SetMap(currRing->cf, currRing->cf);
2850  }
2851  else
2852  // Allow imap/fetch to be make an exception only for:
2853  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2856  ||
2857  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2858  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2859  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2860  {
2861  par_perm_size=rPar(orig_ring);
2862 
2863 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2864 // naSetChar(rInternalChar(orig_ring),orig_ring);
2865 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2866 
2867  nSetChar(currRing->cf);
2868  }
2869  else
2870  {
2871  WerrorS("coefficient fields must be equal if q-ideal !=0");
2872  goto rCompose_err;
2873  }
2874  }
2875  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2876  if (par_perm_size!=0)
2877  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2878  int i;
2879  #if 0
2880  // use imap:
2881  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2882  currRing->names,currRing->N,currRing->parameter, currRing->P,
2883  perm,par_perm, currRing->ch);
2884  #else
2885  // use fetch
2886  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2887  {
2888  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2889  }
2890  else if (par_perm_size!=0)
2891  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2892  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2893  #endif
2894  ideal dest_id=idInit(IDELEMS(q),1);
2895  for(i=IDELEMS(q)-1; i>=0; i--)
2896  {
2897  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2898  par_perm,par_perm_size);
2899  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2900  pTest(dest_id->m[i]);
2901  }
2902  R->qideal=dest_id;
2903  if (perm!=NULL)
2904  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2905  if (par_perm!=NULL)
2906  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2907  rChangeCurrRing(orig_ring);
2908  #endif
2909  }
2910  else
2911  R->qideal=idrCopyR(q,currRing,R);
2912  }
2913  }
2914  else
2915  {
2916  WerrorS("q-ideal must be given as `ideal`");
2917  goto rCompose_err;
2918  }
2919 
2920 
2921  // ---------------------------------------------------------------
2922  #ifdef HAVE_PLURAL
2923  if (L->nr==5)
2924  {
2925  if (nc_CallPlural((matrix)L->m[4].Data(),
2926  (matrix)L->m[5].Data(),
2927  NULL,NULL,
2928  R,
2929  true, // !!!
2930  true, false,
2931  currRing, FALSE)) goto rCompose_err;
2932  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
2933  }
2934  #endif
2935  return R;
2936 
2937 rCompose_err:
2938  if (R->N>0)
2939  {
2940  int i;
2941  if (R->names!=NULL)
2942  {
2943  i=R->N-1;
2944  while (i>=0) { if (R->names[i]!=NULL) omFree(R->names[i]); i--; }
2945  omFree(R->names);
2946  }
2947  }
2948  if (R->order!=NULL) omFree(R->order);
2949  if (R->block0!=NULL) omFree(R->block0);
2950  if (R->block1!=NULL) omFree(R->block1);
2951  if (R->wvhdl!=NULL) omFree(R->wvhdl);
2952  omFree(R);
2953  return NULL;
2954 }
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:2400
Definition: lists.h:22
ring rCompose(const lists L, const BOOLEAN check_comp)
Definition: ipshell.cc:2695
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:996
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2195
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:3938
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2445
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:3351
#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
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:61
struct for passing initialization parameters to naInitChar
Definition: transext.h:92
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:1627
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:2359
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:2746
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:2266
#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:1138
#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:334
#define Warn
Definition: emacs.cc:80

§ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2195 of file ipshell.cc.

2197 {
2198  // ----------------------------------------
2199  // 0: char/ cf - ring
2200  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2201  {
2202  WerrorS("invalid coeff. field description, expecting 0");
2203  return;
2204  }
2205 // R->cf->ch=0;
2206  // ----------------------------------------
2207  // 1:
2208  if (L->m[1].rtyp!=LIST_CMD)
2209  {
2210  WerrorS("invalid coeff. field description, expecting precision list");
2211  return;
2212  }
2213  lists LL=(lists)L->m[1].data;
2214  if (((LL->nr!=2)
2215  || (LL->m[0].rtyp!=INT_CMD)
2216  || (LL->m[1].rtyp!=INT_CMD))
2217  && ((LL->nr!=1)
2218  || (LL->m[0].rtyp!=INT_CMD)))
2219  {
2220  WerrorS("invalid coeff. field description list");
2221  return;
2222  }
2223  int r1=(int)(long)LL->m[0].data;
2224  int r2=(int)(long)LL->m[1].data;
2225  if (L->nr==2) // complex
2226  R->cf = nInitChar(n_long_C, NULL);
2227  else if ((r1<=SHORT_REAL_LENGTH)
2228  && (r2=SHORT_REAL_LENGTH))
2229  R->cf = nInitChar(n_R, NULL);
2230  else
2231  {
2233  p->float_len=r1;
2234  p->float_len2=r2;
2235  R->cf = nInitChar(n_long_R, NULL);
2236  }
2237 
2238  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2239  && (r2=SHORT_REAL_LENGTH))
2240  {
2241  R->cf->float_len=SHORT_REAL_LENGTH/2;
2242  R->cf->float_len2=SHORT_REAL_LENGTH;
2243  }
2244  else
2245  {
2246  R->cf->float_len=si_min(r1,32767);
2247  R->cf->float_len2=si_min(r2,32767);
2248  }
2249  // ----------------------------------------
2250  // 2: list (par)
2251  if (L->nr==2)
2252  {
2253  //R->cf->extRing->N=1;
2254  if (L->m[2].rtyp!=STRING_CMD)
2255  {
2256  WerrorS("invalid coeff. field description, expecting parameter name");
2257  return;
2258  }
2259  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2260  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2261  }
2262  // ----------------------------------------
2263 }
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:89
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:92
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:334
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rComposeOrder()

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

Definition at line 2445 of file ipshell.cc.

2446 {
2447  assume(R!=NULL);
2448  long bitmask=0L;
2449  if (L->m[2].Typ()==LIST_CMD)
2450  {
2451  lists v=(lists)L->m[2].Data();
2452  int n= v->nr+2;
2453  int j_in_R,j_in_L;
2454  // do we have an entry "L",... ?: set bitmask
2455  for (int j=0; j < n-1; j++)
2456  {
2457  if (v->m[j].Typ()==LIST_CMD)
2458  {
2459  lists vv=(lists)v->m[j].Data();
2460  if ((vv->nr==1)
2461  &&(vv->m[0].Typ()==STRING_CMD)
2462  &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2463  {
2464  number nn=(number)vv->m[1].Data();
2465  if (vv->m[1].Typ()==BIGINT_CMD)
2466  bitmask=n_Int(nn,coeffs_BIGINT);
2467  else if (vv->m[1].Typ()==INT_CMD)
2468  bitmask=(long)nn;
2469  else
2470  {
2471  Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2472  return TRUE;
2473  }
2474  break;
2475  }
2476  }
2477  }
2478  if (bitmask!=0) n--;
2479 
2480  // initialize fields of R
2481  R->order=(int *)omAlloc0(n*sizeof(int));
2482  R->block0=(int *)omAlloc0(n*sizeof(int));
2483  R->block1=(int *)omAlloc0(n*sizeof(int));
2484  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
2485  // init order, so that rBlocks works correctly
2486  for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2487  R->order[j_in_R] = (int) ringorder_unspec;
2488  // orderings
2489  for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2490  {
2491  // todo: a(..), M
2492  if (v->m[j_in_L].Typ()!=LIST_CMD)
2493  {
2494  WerrorS("ordering must be list of lists");
2495  return TRUE;
2496  }
2497  lists vv=(lists)v->m[j_in_L].Data();
2498  if ((vv->nr==1)
2499  && (vv->m[0].Typ()==STRING_CMD))
2500  {
2501  if (strcmp((char*)vv->m[0].Data(),"L")==0)
2502  {
2503  j_in_R--;
2504  continue;
2505  }
2506  if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD))
2507  {
2508  PrintS(lString(vv));
2509  WerrorS("ordering name must be a (string,intvec)(1)");
2510  return TRUE;
2511  }
2512  R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2513 
2514  if (j_in_R==0) R->block0[0]=1;
2515  else
2516  {
2517  int jj=j_in_R-1;
2518  while((jj>=0)
2519  && ((R->order[jj]== ringorder_a)
2520  || (R->order[jj]== ringorder_aa)
2521  || (R->order[jj]== ringorder_am)
2522  || (R->order[jj]== ringorder_c)
2523  || (R->order[jj]== ringorder_C)
2524  || (R->order[jj]== ringorder_s)
2525  || (R->order[jj]== ringorder_S)
2526  ))
2527  {
2528  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2529  jj--;
2530  }
2531  if (jj<0) R->block0[j_in_R]=1;
2532  else R->block0[j_in_R]=R->block1[jj]+1;
2533  }
2534  intvec *iv;
2535  if (vv->m[1].Typ()==INT_CMD)
2536  iv=new intvec((int)(long)vv->m[1].Data(),(int)(long)vv->m[1].Data());
2537  else
2538  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC
2539  int iv_len=iv->length();
2540  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2541  if (R->block1[j_in_R]>R->N)
2542  {
2543  R->block1[j_in_R]=R->N;
2544  iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2545  }
2546  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2547  int i;
2548  switch (R->order[j_in_R])
2549  {
2550  case ringorder_ws:
2551  case ringorder_Ws:
2552  R->OrdSgn=-1;
2553  case ringorder_aa:
2554  case ringorder_a:
2555  case ringorder_wp:
2556  case ringorder_Wp:
2557  R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2558  for (i=0; i<iv_len;i++)
2559  {
2560  R->wvhdl[j_in_R][i]=(*iv)[i];
2561  }
2562  break;
2563  case ringorder_am:
2564  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2565  for (i=0; i<iv_len;i++)
2566  {
2567  R->wvhdl[j_in_R][i]=(*iv)[i];
2568  }
2569  R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2570  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2571  for (; i<iv->length(); i++)
2572  {
2573  R->wvhdl[j_in_R][i+1]=(*iv)[i];
2574  }
2575  break;
2576  case ringorder_M:
2577  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2578  for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2579  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length()-1)));
2580  if (R->block1[j_in_R]>R->N)
2581  {
2582  WerrorS("ordering matrix too big");
2583  return TRUE;
2584  }
2585  break;
2586  case ringorder_ls:
2587  case ringorder_ds:
2588  case ringorder_Ds:
2589  case ringorder_rs:
2590  R->OrdSgn=-1;
2591  case ringorder_lp:
2592  case ringorder_dp:
2593  case ringorder_Dp:
2594  case ringorder_rp:
2595  break;
2596  case ringorder_S:
2597  break;
2598  case ringorder_c:
2599  case ringorder_C:
2600  R->block1[j_in_R]=R->block0[j_in_R]=0;
2601  break;
2602 
2603  case ringorder_s:
2604  break;
2605 
2606  case ringorder_IS:
2607  {
2608  R->block1[j_in_R] = R->block0[j_in_R] = 0;
2609  if( iv->length() > 0 )
2610  {
2611  const int s = (*iv)[0];
2612  assume( -2 < s && s < 2 );
2613  R->block1[j_in_R] = R->block0[j_in_R] = s;
2614  }
2615  break;
2616  }
2617  case 0:
2618  case ringorder_unspec:
2619  break;
2620  }
2621  delete iv;
2622  }
2623  else
2624  {
2625  PrintS(lString(vv));
2626  WerrorS("ordering name must be a (string,intvec)");
2627  return TRUE;
2628  }
2629  }
2630  // sanity check
2631  j_in_R=n-2;
2632  if ((R->order[j_in_R]==ringorder_c)
2633  || (R->order[j_in_R]==ringorder_C)
2634  || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2635  if (R->block1[j_in_R] != R->N)
2636  {
2637  if (((R->order[j_in_R]==ringorder_dp) ||
2638  (R->order[j_in_R]==ringorder_ds) ||
2639  (R->order[j_in_R]==ringorder_Dp) ||
2640  (R->order[j_in_R]==ringorder_Ds) ||
2641  (R->order[j_in_R]==ringorder_rp) ||
2642  (R->order[j_in_R]==ringorder_rs) ||
2643  (R->order[j_in_R]==ringorder_lp) ||
2644  (R->order[j_in_R]==ringorder_ls))
2645  &&
2646  R->block0[j_in_R] <= R->N)
2647  {
2648  R->block1[j_in_R] = R->N;
2649  }
2650  else
2651  {
2652  Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2653  return TRUE;
2654  }
2655  }
2656  if (R->block0[j_in_R]>R->N)
2657  {
2658  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2659  for(int ii=0;ii<=j_in_R;ii++)
2660  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2661  return TRUE;
2662  }
2663  if (check_comp)
2664  {
2665  BOOLEAN comp_order=FALSE;
2666  int jj;
2667  for(jj=0;jj<n;jj++)
2668  {
2669  if ((R->order[jj]==ringorder_c) ||
2670  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2671  }
2672  if (!comp_order)
2673  {
2674  R->order=(int*)omRealloc0Size(R->order,n*sizeof(int),(n+1)*sizeof(int));
2675  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2676  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2677  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2678  R->order[n-1]=ringorder_C;
2679  R->block0[n-1]=0;
2680  R->block1[n-1]=0;
2681  R->wvhdl[n-1]=NULL;
2682  n++;
2683  }
2684  }
2685  }
2686  else
2687  {
2688  WerrorS("ordering must be given as `list`");
2689  return TRUE;
2690  }
2691  if (bitmask!=0) R->bitmask=bitmask*2;
2692  return FALSE;
2693 }
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:996
#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
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:329
int rOrderName(char *ordername)
Definition: ring.cc:508
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
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:1138
Definition: tok.h:117
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 2266 of file ipshell.cc.

2268 {
2269  // ----------------------------------------
2270  // 0: string: integer
2271  // no further entries --> Z
2272  mpz_ptr modBase = NULL;
2273  unsigned int modExponent = 1;
2274 
2275  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
2276  if (L->nr == 0)
2277  {
2278  mpz_init_set_ui(modBase,0);
2279  modExponent = 1;
2280  }
2281  // ----------------------------------------
2282  // 1:
2283  else
2284  {
2285  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2286  lists LL=(lists)L->m[1].data;
2287  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2288  {
2289  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2290  // assume that tmp is integer, not rational
2291  n_MPZ (modBase, tmp, coeffs_BIGINT);
2292  }
2293  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2294  {
2295  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2296  }
2297  else
2298  {
2299  mpz_init_set_ui(modBase,0);
2300  }
2301  if (LL->nr >= 1)
2302  {
2303  modExponent = (unsigned long) LL->m[1].data;
2304  }
2305  else
2306  {
2307  modExponent = 1;
2308  }
2309  }
2310  // ----------------------------------------
2311  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2312  {
2313  WerrorS("Wrong ground ring specification (module is 1)");
2314  return;
2315  }
2316  if (modExponent < 1)
2317  {
2318  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2319  return;
2320  }
2321  // module is 0 ---> integers
2322  if (mpz_cmp_ui(modBase, 0) == 0)
2323  {
2324  R->cf=nInitChar(n_Z,NULL);
2325  }
2326  // we have an exponent
2327  else if (modExponent > 1)
2328  {
2329  //R->cf->ch = R->cf->modExponent;
2330  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2331  {
2332  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2333  depending on the size of a long on the respective platform */
2334  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2335  omFreeSize (modBase, sizeof(mpz_t));
2336  }
2337  else
2338  {
2339  //ringtype 3
2340  ZnmInfo info;
2341  info.base= modBase;
2342  info.exp= modExponent;
2343  R->cf=nInitChar(n_Znm,(void*) &info);
2344  }
2345  }
2346  // just a module m > 1
2347  else
2348  {
2349  //ringtype = 2;
2350  //const int ch = mpz_get_ui(modBase);
2351  ZnmInfo info;
2352  info.base= modBase;
2353  info.exp= modExponent;
2354  R->cf=nInitChar(n_Zn,(void*) &info);
2355  }
2356 }
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
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:54
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
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:92
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:334

§ rComposeVar()

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

Definition at line 2400 of file ipshell.cc.

2401 {
2402  assume(R!=NULL);
2403  if (L->m[1].Typ()==LIST_CMD)
2404  {
2405  lists v=(lists)L->m[1].Data();
2406  R->N = v->nr+1;
2407  if (R->N<=0)
2408  {
2409  WerrorS("no ring variables");
2410  return TRUE;
2411  }
2412  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2413  int i;
2414  for(i=0;i<R->N;i++)
2415  {
2416  if (v->m[i].Typ()==STRING_CMD)
2417  R->names[i]=omStrDup((char *)v->m[i].Data());
2418  else if (v->m[i].Typ()==POLY_CMD)
2419  {
2420  poly p=(poly)v->m[i].Data();
2421  int nr=pIsPurePower(p);
2422  if (nr>0)
2423  R->names[i]=omStrDup(currRing->names[nr-1]);
2424  else
2425  {
2426  Werror("var name %d must be a string or a ring variable",i+1);
2427  return TRUE;
2428  }
2429  }
2430  else
2431  {
2432  Werror("var name %d must be `string`",i+1);
2433  return TRUE;
2434  }
2435  }
2436  }
2437  else
2438  {
2439  WerrorS("variable must be given as `list`");
2440  return TRUE;
2441  }
2442  return FALSE;
2443 }
#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:996
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:1138
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 2010 of file ipshell.cc.

2011 {
2012  assume( r != NULL );
2013  const coeffs C = r->cf;
2014  assume( C != NULL );
2015 
2016  // sanity check: require currRing==r for rings with polynomial data
2017  if ( (r!=currRing) && (
2018  (nCoeff_is_algExt(C) && (C != currRing->cf))
2019  || (r->qideal != NULL)
2020 #ifdef HAVE_PLURAL
2021  || (rIsPluralRing(r))
2022 #endif
2023  )
2024  )
2025  {
2026  WerrorS("ring with polynomial data must be the base ring or compatible");
2027  return NULL;
2028  }
2029  // 0: char/ cf - ring
2030  // 1: list (var)
2031  // 2: list (ord)
2032  // 3: qideal
2033  // possibly:
2034  // 4: C
2035  // 5: D
2037  if (rIsPluralRing(r))
2038  L->Init(6);
2039  else
2040  L->Init(4);
2041  // ----------------------------------------
2042  // 0: char/ cf - ring
2043  if (rField_is_numeric(r))
2044  {
2045  rDecomposeC(&(L->m[0]),r);
2046  }
2047  else if (rField_is_Ring(r))
2048  {
2049  rDecomposeRing(&(L->m[0]),r);
2050  }
2051  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2052  {
2053  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2054  }
2055  else if(rField_is_GF(r))
2056  {
2058  Lc->Init(4);
2059  // char:
2060  Lc->m[0].rtyp=INT_CMD;
2061  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2062  // var:
2064  Lv->Init(1);
2065  Lv->m[0].rtyp=STRING_CMD;
2066  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2067  Lc->m[1].rtyp=LIST_CMD;
2068  Lc->m[1].data=(void*)Lv;
2069  // ord:
2071  Lo->Init(1);
2073  Loo->Init(2);
2074  Loo->m[0].rtyp=STRING_CMD;
2075  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2076 
2077  intvec *iv=new intvec(1); (*iv)[0]=1;
2078  Loo->m[1].rtyp=INTVEC_CMD;
2079  Loo->m[1].data=(void *)iv;
2080 
2081  Lo->m[0].rtyp=LIST_CMD;
2082  Lo->m[0].data=(void*)Loo;
2083 
2084  Lc->m[2].rtyp=LIST_CMD;
2085  Lc->m[2].data=(void*)Lo;
2086  // q-ideal:
2087  Lc->m[3].rtyp=IDEAL_CMD;
2088  Lc->m[3].data=(void *)idInit(1,1);
2089  // ----------------------
2090  L->m[0].rtyp=LIST_CMD;
2091  L->m[0].data=(void*)Lc;
2092  }
2093  else
2094  {
2095  L->m[0].rtyp=INT_CMD;
2096  L->m[0].data=(void *)(long)r->cf->ch;
2097  }
2098  // ----------------------------------------
2099  // 1: list (var)
2101  LL->Init(r->N);
2102  int i;
2103  for(i=0; i<r->N; i++)
2104  {
2105  LL->m[i].rtyp=STRING_CMD;
2106  LL->m[i].data=(void *)omStrDup(r->names[i]);
2107  }
2108  L->m[1].rtyp=LIST_CMD;
2109  L->m[1].data=(void *)LL;
2110  // ----------------------------------------
2111  // 2: list (ord)
2113  i=rBlocks(r)-1;
2114  LL->Init(i);
2115  i--;
2116  lists LLL;
2117  for(; i>=0; i--)
2118  {
2119  intvec *iv;
2120  int j;
2121  LL->m[i].rtyp=LIST_CMD;
2123  LLL->Init(2);
2124  LLL->m[0].rtyp=STRING_CMD;
2125  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2126 
2127  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2128  {
2129  assume( r->block0[i] == r->block1[i] );
2130  const int s = r->block0[i];
2131  assume( -2 < s && s < 2);
2132 
2133  iv=new intvec(1);
2134  (*iv)[0] = s;
2135  }
2136  else if (r->block1[i]-r->block0[i] >=0 )
2137  {
2138  int bl=j=r->block1[i]-r->block0[i];
2139  if (r->order[i]==ringorder_M)
2140  {
2141  j=(j+1)*(j+1)-1;
2142  bl=j+1;
2143  }
2144  else if (r->order[i]==ringorder_am)
2145  {
2146  j+=r->wvhdl[i][bl+1];
2147  }
2148  iv=new intvec(j+1);
2149  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2150  {
2151  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2152  }
2153  else switch (r->order[i])
2154  {
2155  case ringorder_dp:
2156  case ringorder_Dp:
2157  case ringorder_ds:
2158  case ringorder_Ds:
2159  case ringorder_lp:
2160  for(;j>=0; j--) (*iv)[j]=1;
2161  break;
2162  default: /* do nothing */;
2163  }
2164  }
2165  else
2166  {
2167  iv=new intvec(1);
2168  }
2169  LLL->m[1].rtyp=INTVEC_CMD;
2170  LLL->m[1].data=(void *)iv;
2171  LL->m[i].data=(void *)LLL;
2172  }
2173  L->m[2].rtyp=LIST_CMD;
2174  L->m[2].data=(void *)LL;
2175  // ----------------------------------------
2176  // 3: qideal
2177  L->m[3].rtyp=IDEAL_CMD;
2178  if (r->qideal==NULL)
2179  L->m[3].data=(void *)idInit(1,1);
2180  else
2181  L->m[3].data=(void *)idCopy(r->qideal);
2182  // ----------------------------------------
2183 #ifdef HAVE_PLURAL // NC! in rDecompose
2184  if (rIsPluralRing(r))
2185  {
2186  L->m[4].rtyp=MATRIX_CMD;
2187  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2188  L->m[5].rtyp=MATRIX_CMD;
2189  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2190  }
2191 #endif
2192  return L;
2193 }
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:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1590
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:1712
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:1776
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:92
Definition: tok.h:117
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:74
omBin slists_bin
Definition: lists.cc:23
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 1808 of file ipshell.cc.

1809 {
1810  assume( C != NULL );
1811 
1812  // sanity check: require currRing==r for rings with polynomial data
1813  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1814  {
1815  WerrorS("ring with polynomial data must be the base ring or compatible");
1816  return TRUE;
1817  }
1818  if (nCoeff_is_numeric(C))
1819  {
1820  rDecomposeC_41(res,C);
1821  }
1822 #ifdef HAVE_RINGS
1823  else if (nCoeff_is_Ring(C))
1824  {
1825  rDecomposeRing_41(res,C);
1826  }
1827 #endif
1828  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1829  {
1830  rDecomposeCF(res, C->extRing, currRing);
1831  }
1832  else if(nCoeff_is_GF(C))
1833  {
1835  Lc->Init(4);
1836  // char:
1837  Lc->m[0].rtyp=INT_CMD;
1838  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1839  // var:
1841  Lv->Init(1);
1842  Lv->m[0].rtyp=STRING_CMD;
1843  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1844  Lc->m[1].rtyp=LIST_CMD;
1845  Lc->m[1].data=(void*)Lv;
1846  // ord:
1848  Lo->Init(1);
1850  Loo->Init(2);
1851  Loo->m[0].rtyp=STRING_CMD;
1852  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1853 
1854  intvec *iv=new intvec(1); (*iv)[0]=1;
1855  Loo->m[1].rtyp=INTVEC_CMD;
1856  Loo->m[1].data=(void *)iv;
1857 
1858  Lo->m[0].rtyp=LIST_CMD;
1859  Lo->m[0].data=(void*)Loo;
1860 
1861  Lc->m[2].rtyp=LIST_CMD;
1862  Lc->m[2].data=(void*)Lo;
1863  // q-ideal:
1864  Lc->m[3].rtyp=IDEAL_CMD;
1865  Lc->m[3].data=(void *)idInit(1,1);
1866  // ----------------------
1867  res->rtyp=LIST_CMD;
1868  res->data=(void*)Lc;
1869  }
1870  else
1871  {
1872  res->rtyp=INT_CMD;
1873  res->data=(void *)(long)C->ch;
1874  }
1875  // ----------------------------------------
1876  return FALSE;
1877 }
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:1748
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1590
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:1678
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:92
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 1879 of file ipshell.cc.

1880 {
1881  assume( r != NULL );
1882  const coeffs C = r->cf;
1883  assume( C != NULL );
1884 
1885  // sanity check: require currRing==r for rings with polynomial data
1886  if ( (r!=currRing) && (
1887  (r->qideal != NULL)
1888 #ifdef HAVE_PLURAL
1889  || (rIsPluralRing(r))
1890 #endif
1891  )
1892  )
1893  {
1894  WerrorS("ring with polynomial data must be the base ring or compatible");
1895  return NULL;
1896  }
1897  // 0: char/ cf - ring
1898  // 1: list (var)
1899  // 2: list (ord)
1900  // 3: qideal
1901  // possibly:
1902  // 4: C
1903  // 5: D
1905  if (rIsPluralRing(r))
1906  L->Init(6);
1907  else
1908  L->Init(4);
1909  // ----------------------------------------
1910  // 0: char/ cf - ring
1911  L->m[0].rtyp=CRING_CMD;
1912  L->m[0].data=(char*)r->cf; r->cf->ref++;
1913  // ----------------------------------------
1914  // 1: list (var)
1916  LL->Init(r->N);
1917  int i;
1918  for(i=0; i<r->N; i++)
1919  {
1920  LL->m[i].rtyp=STRING_CMD;
1921  LL->m[i].data=(void *)omStrDup(r->names[i]);
1922  }
1923  L->m[1].rtyp=LIST_CMD;
1924  L->m[1].data=(void *)LL;
1925  // ----------------------------------------
1926  // 2: list (ord)
1928  i=rBlocks(r)-1;
1929  LL->Init(i);
1930  i--;
1931  lists LLL;
1932  for(; i>=0; i--)
1933  {
1934  intvec *iv;
1935  int j;
1936  LL->m[i].rtyp=LIST_CMD;
1938  LLL->Init(2);
1939  LLL->m[0].rtyp=STRING_CMD;
1940  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1941 
1942  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1943  {
1944  assume( r->block0[i] == r->block1[i] );
1945  const int s = r->block0[i];
1946  assume( -2 < s && s < 2);
1947 
1948  iv=new intvec(1);
1949  (*iv)[0] = s;
1950  }
1951  else if (r->block1[i]-r->block0[i] >=0 )
1952  {
1953  int bl=j=r->block1[i]-r->block0[i];
1954  if (r->order[i]==ringorder_M)
1955  {
1956  j=(j+1)*(j+1)-1;
1957  bl=j+1;
1958  }
1959  else if (r->order[i]==ringorder_am)
1960  {
1961  j+=r->wvhdl[i][bl+1];
1962  }
1963  iv=new intvec(j+1);
1964  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1965  {
1966  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1967  }
1968  else switch (r->order[i])
1969  {
1970  case ringorder_dp:
1971  case ringorder_Dp:
1972  case ringorder_ds:
1973  case ringorder_Ds:
1974  case ringorder_lp:
1975  for(;j>=0; j--) (*iv)[j]=1;
1976  break;
1977  default: /* do nothing */;
1978  }
1979  }
1980  else
1981  {
1982  iv=new intvec(1);
1983  }
1984  LLL->m[1].rtyp=INTVEC_CMD;
1985  LLL->m[1].data=(void *)iv;
1986  LL->m[i].data=(void *)LLL;
1987  }
1988  L->m[2].rtyp=LIST_CMD;
1989  L->m[2].data=(void *)LL;
1990  // ----------------------------------------
1991  // 3: qideal
1992  L->m[3].rtyp=IDEAL_CMD;
1993  if (r->qideal==NULL)
1994  L->m[3].data=(void *)idInit(1,1);
1995  else
1996  L->m[3].data=(void *)idCopy(r->qideal);
1997  // ----------------------------------------
1998 #ifdef HAVE_PLURAL // NC! in rDecompose
1999  if (rIsPluralRing(r))
2000  {
2001  L->m[4].rtyp=MATRIX_CMD;
2002  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2003  L->m[5].rtyp=MATRIX_CMD;
2004  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2005  }
2006 #endif
2007  return L;
2008 }
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:89
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:92
Definition: tok.h:117
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:74
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 1712 of file ipshell.cc.

1714 {
1716  if (rField_is_long_C(R)) L->Init(3);
1717  else L->Init(2);
1718  h->rtyp=LIST_CMD;
1719  h->data=(void *)L;
1720  // 0: char/ cf - ring
1721  // 1: list (var)
1722  // 2: list (ord)
1723  // ----------------------------------------
1724  // 0: char/ cf - ring
1725  L->m[0].rtyp=INT_CMD;
1726  L->m[0].data=(void *)0;
1727  // ----------------------------------------
1728  // 1:
1730  LL->Init(2);
1731  LL->m[0].rtyp=INT_CMD;
1732  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1733  LL->m[1].rtyp=INT_CMD;
1734  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1735  L->m[1].rtyp=LIST_CMD;
1736  L->m[1].data=(void *)LL;
1737  // ----------------------------------------
1738  // 2: list (par)
1739  if (rField_is_long_C(R))
1740  {
1741  L->m[2].rtyp=STRING_CMD;
1742  L->m[2].data=(void *)omStrDup(*rParameter(R));
1743  }
1744  // ----------------------------------------
1745 }
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:89
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:92
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 1678 of file ipshell.cc.

1680 {
1682  if (nCoeff_is_long_C(C)) L->Init(3);
1683  else L->Init(2);
1684  h->rtyp=LIST_CMD;
1685  h->data=(void *)L;
1686  // 0: char/ cf - ring
1687  // 1: list (var)
1688  // 2: list (ord)
1689  // ----------------------------------------
1690  // 0: char/ cf - ring
1691  L->m[0].rtyp=INT_CMD;
1692  L->m[0].data=(void *)0;
1693  // ----------------------------------------
1694  // 1:
1696  LL->Init(2);
1697  LL->m[0].rtyp=INT_CMD;
1698  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1699  LL->m[1].rtyp=INT_CMD;
1700  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1701  L->m[1].rtyp=LIST_CMD;
1702  L->m[1].data=(void *)LL;
1703  // ----------------------------------------
1704  // 2: list (par)
1705  if (nCoeff_is_long_C(C))
1706  {
1707  L->m[2].rtyp=STRING_CMD;
1708  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1709  }
1710  // ----------------------------------------
1711 }
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:89
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:92
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 1590 of file ipshell.cc.

1591 {
1593  L->Init(4);
1594  h->rtyp=LIST_CMD;
1595  h->data=(void *)L;
1596  // 0: char/ cf - ring
1597  // 1: list (var)
1598  // 2: list (ord)
1599  // 3: qideal
1600  // ----------------------------------------
1601  // 0: char/ cf - ring
1602  L->m[0].rtyp=INT_CMD;
1603  L->m[0].data=(void *)(long)r->cf->ch;
1604  // ----------------------------------------
1605  // 1: list (var)
1607  LL->Init(r->N);
1608  int i;
1609  for(i=0; i<r->N; i++)
1610  {
1611  LL->m[i].rtyp=STRING_CMD;
1612  LL->m[i].data=(void *)omStrDup(r->names[i]);
1613  }
1614  L->m[1].rtyp=LIST_CMD;
1615  L->m[1].data=(void *)LL;
1616  // ----------------------------------------
1617  // 2: list (ord)
1619  i=rBlocks(r)-1;
1620  LL->Init(i);
1621  i--;
1622  lists LLL;
1623  for(; i>=0; i--)
1624  {
1625  intvec *iv;
1626  int j;
1627  LL->m[i].rtyp=LIST_CMD;
1629  LLL->Init(2);
1630  LLL->m[0].rtyp=STRING_CMD;
1631  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1632  if (r->block1[i]-r->block0[i] >=0 )
1633  {
1634  j=r->block1[i]-r->block0[i];
1635  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1636  iv=new intvec(j+1);
1637  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1638  {
1639  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1640  }
1641  else switch (r->order[i])
1642  {
1643  case ringorder_dp:
1644  case ringorder_Dp:
1645  case ringorder_ds:
1646  case ringorder_Ds:
1647  case ringorder_lp:
1648  for(;j>=0; j--) (*iv)[j]=1;
1649  break;
1650  default: /* do nothing */;
1651  }
1652  }
1653  else
1654  {
1655  iv=new intvec(1);
1656  }
1657  LLL->m[1].rtyp=INTVEC_CMD;
1658  LLL->m[1].data=(void *)iv;
1659  LL->m[i].data=(void *)LLL;
1660  }
1661  L->m[2].rtyp=LIST_CMD;
1662  L->m[2].data=(void *)LL;
1663  // ----------------------------------------
1664  // 3: qideal
1665  L->m[3].rtyp=IDEAL_CMD;
1666  if (nCoeff_is_transExt(R->cf))
1667  L->m[3].data=(void *)idInit(1,1);
1668  else
1669  {
1670  ideal q=idInit(IDELEMS(r->qideal));
1671  q->m[0]=p_Init(R);
1672  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1673  L->m[3].data=(void *)q;
1674 // I->m[0] = pNSet(R->minpoly);
1675  }
1676  // ----------------------------------------
1677 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
void * data
Definition: subexpr.h:89
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:92
#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 1776 of file ipshell.cc.

1778 {
1779 #ifdef HAVE_RINGS
1781  if (rField_is_Ring_Z(R)) L->Init(1);
1782  else L->Init(2);
1783  h->rtyp=LIST_CMD;
1784  h->data=(void *)L;
1785  // 0: char/ cf - ring
1786  // 1: list (module)
1787  // ----------------------------------------
1788  // 0: char/ cf - ring
1789  L->m[0].rtyp=STRING_CMD;
1790  L->m[0].data=(void *)omStrDup("integer");
1791  // ----------------------------------------
1792  // 1: module
1793  if (rField_is_Ring_Z(R)) return;
1795  LL->Init(2);
1796  LL->m[0].rtyp=BIGINT_CMD;
1797  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); ?
1798  LL->m[1].rtyp=INT_CMD;
1799  LL->m[1].data=(void *) R->cf->modExponent;
1800  L->m[1].rtyp=LIST_CMD;
1801  L->m[1].data=(void *)LL;
1802 #else
1803  WerrorS("rDecomposeRing");
1804 #endif
1805 }
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:89
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:92
Definition: tok.h:117
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:206
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 1748 of file ipshell.cc.

1750 {
1752  if (nCoeff_is_Ring(C)) L->Init(1);
1753  else L->Init(2);
1754  h->rtyp=LIST_CMD;
1755  h->data=(void *)L;
1756  // 0: char/ cf - ring
1757  // 1: list (module)
1758  // ----------------------------------------
1759  // 0: char/ cf - ring
1760  L->m[0].rtyp=STRING_CMD;
1761  L->m[0].data=(void *)omStrDup("integer");
1762  // ----------------------------------------
1763  // 1: modulo
1764  if (nCoeff_is_Ring_Z(C)) return;
1766  LL->Init(2);
1767  LL->m[0].rtyp=BIGINT_CMD;
1768  LL->m[0].data=nlMapGMP((number) C->modBase, C, coeffs_BIGINT);
1769  LL->m[1].rtyp=INT_CMD;
1770  LL->m[1].data=(void *) C->modExponent;
1771  L->m[1].rtyp=LIST_CMD;
1772  L->m[1].data=(void *)LL;
1773 }
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:89
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:92
Definition: tok.h:117
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:206
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1519 of file ipshell.cc.

1520 {
1521  idhdl tmp=NULL;
1522 
1523  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1524  if (tmp==NULL) return NULL;
1525 
1526 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1528  {
1530  memset(&sLastPrinted,0,sizeof(sleftv));
1531  }
1532 
1533  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1534 
1535  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1536  r->N = 3;
1537  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1538  /*names*/
1539  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1540  r->names[0] = omStrDup("x");
1541  r->names[1] = omStrDup("y");
1542  r->names[2] = omStrDup("z");
1543  /*weights: entries for 3 blocks: NULL*/
1544  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1545  /*order: dp,C,0*/
1546  r->order = (int *) omAlloc(3 * sizeof(int *));
1547  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1548  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1549  /* ringorder dp for the first block: var 1..3 */
1550  r->order[0] = ringorder_dp;
1551  r->block0[0] = 1;
1552  r->block1[0] = 3;
1553  /* ringorder C for the second block: no vars */
1554  r->order[1] = ringorder_C;
1555  /* the last block: everything is 0 */
1556  r->order[2] = 0;
1557 
1558  /* complete ring intializations */
1559  rComplete(r);
1560  rSetHdl(tmp);
1561  return currRingHdl;
1562 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
{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:259
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:403
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:3351
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:333
void rSetHdl(idhdl h)
Definition: ipshell.cc:5002
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:334
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1564 of file ipshell.cc.

1565 {
1567  if (h!=NULL) return h;
1568  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1569  if (h!=NULL) return h;
1571  while(p!=NULL)
1572  {
1573  if ((p->cPack!=basePack)
1574  && (p->cPack!=currPack))
1575  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1576  if (h!=NULL) return h;
1577  p=p->next;
1578  }
1579  idhdl tmp=basePack->idroot;
1580  while (tmp!=NULL)
1581  {
1582  if (IDTYP(tmp)==PACKAGE_CMD)
1583  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1584  if (h!=NULL) return h;
1585  tmp=IDNEXT(tmp);
1586  }
1587  return NULL;
1588 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6103
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 5488 of file ipshell.cc.

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

§ rKill() [1/2]

void rKill ( ring  r)

Definition at line 6026 of file ipshell.cc.

6027 {
6028  if ((r->ref<=0)&&(r->order!=NULL))
6029  {
6030 #ifdef RDEBUG
6031  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6032 #endif
6033  if (r->qideal!=NULL)
6034  {
6035  id_Delete(&r->qideal, r);
6036  r->qideal = NULL;
6037  }
6038  int j;
6039  for (j=0;j<myynest;j++)
6040  {
6041  if (iiLocalRing[j]==r)
6042  {
6043  if (j==0) WarnS("killing the basering for level 0");
6044  iiLocalRing[j]=NULL;
6045  }
6046  }
6047 // any variables depending on r ?
6048  while (r->idroot!=NULL)
6049  {
6050  r->idroot->lev=myynest; // avoid warning about kill global objects
6051  killhdl2(r->idroot,&(r->idroot),r);
6052  }
6053  if (r==currRing)
6054  {
6055  // all dependend stuff is done, clean global vars:
6056  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6058  {
6060  }
6061  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6062  //{
6063  // WerrorS("return value depends on local ring variable (export missing ?)");
6064  // iiRETURNEXPR.CleanUp();
6065  //}
6066  currRing=NULL;
6067  currRingHdl=NULL;
6068  }
6069 
6070  /* nKillChar(r); will be called from inside of rDelete */
6071  rDelete(r);
6072  return;
6073  }
6074  r->ref--;
6075 }
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
#define Print
Definition: emacs.cc:83
void id_Delete(ideal *h, ring r)
deletes an ideal/module/matrix
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:409
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:403
int j
Definition: myNF.cc:70
idhdl currRingHdl
Definition: ipid.cc:65
ring * iiLocalRing
Definition: iplib.cc:470
#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:333

§ rKill() [2/2]

void rKill ( idhdl  h)

Definition at line 6077 of file ipshell.cc.

6078 {
6079  ring r = IDRING(h);
6080  int ref=0;
6081  if (r!=NULL)
6082  {
6083  // avoid, that sLastPrinted is the last reference to the base ring:
6084  // clean up before killing the last "named" refrence:
6085  if ((sLastPrinted.rtyp==RING_CMD)
6086  && (sLastPrinted.data==(void*)r))
6087  {
6088  sLastPrinted.CleanUp(r);
6089  }
6090  ref=r->ref;
6091  rKill(r);
6092  }
6093  if (h==currRingHdl)
6094  {
6095  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6096  else
6097  {
6099  }
6100  }
6101 }
void * data
Definition: subexpr.h:89
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:6026
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1564
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
int rtyp
Definition: subexpr.h:92
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333

§ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5056 of file ipshell.cc.

5057 {
5058  // change some bad orderings/combination into better ones
5059  leftv h=ord;
5060  while(h!=NULL)
5061  {
5062  BOOLEAN change=FALSE;
5063  intvec *iv = (intvec *)(h->data);
5064  // ws(-i) -> wp(i)
5065  if ((*iv)[1]==ringorder_ws)
5066  {
5067  BOOLEAN neg=TRUE;
5068  for(int i=2;i<iv->length();i++)
5069  if((*iv)[i]>=0) { neg=FALSE; break; }
5070  if (neg)
5071  {
5072  (*iv)[1]=ringorder_wp;
5073  for(int i=2;i<iv->length();i++)
5074  (*iv)[i]= - (*iv)[i];
5075  change=TRUE;
5076  }
5077  }
5078  // Ws(-i) -> Wp(i)
5079  if ((*iv)[1]==ringorder_Ws)
5080  {
5081  BOOLEAN neg=TRUE;
5082  for(int i=2;i<iv->length();i++)
5083  if((*iv)[i]>=0) { neg=FALSE; break; }
5084  if (neg)
5085  {
5086  (*iv)[1]=ringorder_Wp;
5087  for(int i=2;i<iv->length();i++)
5088  (*iv)[i]= -(*iv)[i];
5089  change=TRUE;
5090  }
5091  }
5092  // wp(1) -> dp
5093  if ((*iv)[1]==ringorder_wp)
5094  {
5095  BOOLEAN all_one=TRUE;
5096  for(int i=2;i<iv->length();i++)
5097  if((*iv)[i]!=1) { all_one=FALSE; break; }
5098  if (all_one)
5099  {
5100  intvec *iv2=new intvec(3);
5101  (*iv2)[0]=1;
5102  (*iv2)[1]=ringorder_dp;
5103  (*iv2)[2]=iv->length()-2;
5104  delete iv;
5105  iv=iv2;
5106  h->data=iv2;
5107  change=TRUE;
5108  }
5109  }
5110  // Wp(1) -> Dp
5111  if ((*iv)[1]==ringorder_Wp)
5112  {
5113  BOOLEAN all_one=TRUE;
5114  for(int i=2;i<iv->length();i++)
5115  if((*iv)[i]!=1) { all_one=FALSE; break; }
5116  if (all_one)
5117  {
5118  intvec *iv2=new intvec(3);
5119  (*iv2)[0]=1;
5120  (*iv2)[1]=ringorder_Dp;
5121  (*iv2)[2]=iv->length()-2;
5122  delete iv;
5123  iv=iv2;
5124  h->data=iv2;
5125  change=TRUE;
5126  }
5127  }
5128  // dp(1)/Dp(1)/rp(1) -> lp(1)
5129  if (((*iv)[1]==ringorder_dp)
5130  || ((*iv)[1]==ringorder_Dp)
5131  || ((*iv)[1]==ringorder_rp))
5132  {
5133  if (iv->length()==3)
5134  {
5135  if ((*iv)[2]==1)
5136  {
5137  (*iv)[1]=ringorder_lp;
5138  change=TRUE;
5139  }
5140  }
5141  }
5142  // lp(i),lp(j) -> lp(i+j)
5143  if(((*iv)[1]==ringorder_lp)
5144  && (h->next!=NULL))
5145  {
5146  intvec *iv2 = (intvec *)(h->next->data);
5147  if ((*iv2)[1]==ringorder_lp)
5148  {
5149  leftv hh=h->next;
5150  h->next=hh->next;
5151  hh->next=NULL;
5152  if ((*iv2)[0]==1)
5153  (*iv)[2] += 1; // last block unspecified, at least 1
5154  else
5155  (*iv)[2] += (*iv2)[2];
5156  hh->CleanUp();
5157  omFree(hh);
5158  change=TRUE;
5159  }
5160  }
5161  // -------------------
5162  if (!change) h=h->next;
5163  }
5164  return ord;
5165 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void * data
Definition: subexpr.h:89
Definition: intvec.h:14
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:86
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85

§ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2359 of file ipshell.cc.

2360 {
2361  int i,j;
2362  BOOLEAN ch;
2363  do
2364  {
2365  ch=0;
2366  for(i=0;i<R->N-1;i++)
2367  {
2368  for(j=i+1;j<R->N;j++)
2369  {
2370  if (strcmp(R->names[i],R->names[j])==0)
2371  {
2372  ch=TRUE;
2373  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2374  omFree(R->names[j]);
2375  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2376  sprintf(R->names[j],"@%s",R->names[i]);
2377  }
2378  }
2379  }
2380  }
2381  while (ch);
2382  for(i=0;i<rPar(R); i++)
2383  {
2384  for(j=0;j<R->N;j++)
2385  {
2386  if (strcmp(rParameter(R)[i],R->names[j])==0)
2387  {
2388  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2389 // omFree(rParameter(R)[i]);
2390 // rParameter(R)[i]=(char *)omAlloc(10);
2391 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2392  omFree(R->names[j]);
2393  R->names[j]=(char *)omAlloc(10);
2394  sprintf(R->names[j],"@@(%d)",i+1);
2395  }
2396  }
2397  }
2398 }
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 5002 of file ipshell.cc.

5003 {
5004  ring rg = NULL;
5005  if (h!=NULL)
5006  {
5007 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5008  rg = IDRING(h);
5009  if (rg==NULL) return; //id <>NULL, ring==NULL
5010  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5011  if (IDID(h)) // OB: ????
5012  omCheckAddr((ADDRESS)IDID(h));
5013  rTest(rg);
5014  }
5015 
5016  // clean up history
5018  {
5020  memset(&sLastPrinted,0,sizeof(sleftv));
5021  }
5022 
5023  if ((rg!=currRing)&&(currRing!=NULL))
5024  {
5026  if (DENOMINATOR_LIST!=NULL)
5027  {
5028  if (TEST_V_ALLWARN)
5029  Warn("deleting denom_list for ring change to %s",IDID(h));
5030  do
5031  {
5032  n_Delete(&(dd->n),currRing->cf);
5033  dd=dd->next;
5035  DENOMINATOR_LIST=dd;
5036  } while(DENOMINATOR_LIST!=NULL);
5037  }
5038  }
5039 
5040  // test for valid "currRing":
5041  if ((rg!=NULL) && (rg->idroot==NULL))
5042  {
5043  ring old=rg;
5044  rg=rAssure_HasComp(rg);
5045  if (old!=rg)
5046  {
5047  rKill(old);
5048  IDRING(h)=rg;
5049  }
5050  }
5051  /*------------ change the global ring -----------------------*/
5052  rChangeCurrRing(rg);
5053  currRingHdl = h;
5054 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#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:4522
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:403
void rKill(ring r)
Definition: ipshell.cc:6026
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:778
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:67
#define IDRING(a)
Definition: ipid.h:124
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
#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 6103 of file ipshell.cc.

6104 {
6105  idhdl h=root;
6106  while (h!=NULL)
6107  {
6108  if ((IDTYP(h)==RING_CMD)
6109  && (h!=n)
6110  && (IDRING(h)==r)
6111  )
6112  {
6113  return h;
6114  }
6115  h=IDNEXT(h);
6116  }
6117  return NULL;
6118 }
#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 5440 of file ipshell.cc.

5441 {
5442 
5443  while(sl!=NULL)
5444  {
5445  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5446  {
5447  *p = omStrDup(sl->Name());
5448  }
5449  else if (sl->name!=NULL)
5450  {
5451  *p = (char*)sl->name;
5452  sl->name=NULL;
5453  }
5454  else if (sl->rtyp==POLY_CMD)
5455  {
5456  sleftv s_sl;
5457  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5458  if (s_sl.name != NULL)
5459  {
5460  *p = (char*)s_sl.name; s_sl.name=NULL;
5461  }
5462  else
5463  *p = NULL;
5464  sl->next = s_sl.next;
5465  s_sl.next = NULL;
5466  s_sl.CleanUp();
5467  if (*p == NULL) return TRUE;
5468  }
5469  else return TRUE;
5470  p++;
5471  sl=sl->next;
5472  }
5473  return FALSE;
5474 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#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:121
#define IDHDL
Definition: tok.h:31
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
Definition: tok.h:34
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:333
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5168 of file ipshell.cc.

5169 {
5170  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5171  ord=rOptimizeOrdAsSleftv(ord);
5172  sleftv *sl = ord;
5173 
5174  // determine nBlocks
5175  while (sl!=NULL)
5176  {
5177  intvec *iv = (intvec *)(sl->data);
5178  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5179  i++;
5180  else if ((*iv)[1]==ringorder_L)
5181  {
5182  R->bitmask=(*iv)[2];
5183  n--;
5184  }
5185  else if (((*iv)[1]!=ringorder_a)
5186  && ((*iv)[1]!=ringorder_a64)
5187  && ((*iv)[1]!=ringorder_am))
5188  o++;
5189  n++;
5190  sl=sl->next;
5191  }
5192  // check whether at least one real ordering
5193  if (o==0)
5194  {
5195  WerrorS("invalid combination of orderings");
5196  return TRUE;
5197  }
5198  // if no c/C ordering is given, increment n
5199  if (i==0) n++;
5200  else if (i != 1)
5201  {
5202  // throw error if more than one is given
5203  WerrorS("more than one ordering c/C specified");
5204  return TRUE;
5205  }
5206 
5207  // initialize fields of R
5208  R->order=(int *)omAlloc0(n*sizeof(int));
5209  R->block0=(int *)omAlloc0(n*sizeof(int));
5210  R->block1=(int *)omAlloc0(n*sizeof(int));
5211  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5212 
5213  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5214 
5215  // init order, so that rBlocks works correctly
5216  for (j=0; j < n-1; j++)
5217  R->order[j] = (int) ringorder_unspec;
5218  // set last _C order, if no c/C order was given
5219  if (i == 0) R->order[n-2] = ringorder_C;
5220 
5221  /* init orders */
5222  sl=ord;
5223  n=-1;
5224  while (sl!=NULL)
5225  {
5226  intvec *iv;
5227  iv = (intvec *)(sl->data);
5228  if ((*iv)[1]!=ringorder_L)
5229  {
5230  n++;
5231 
5232  /* the format of an ordering:
5233  * iv[0]: factor
5234  * iv[1]: ordering
5235  * iv[2..end]: weights
5236  */
5237  R->order[n] = (*iv)[1];
5238  typ=1;
5239  switch ((*iv)[1])
5240  {
5241  case ringorder_ws:
5242  case ringorder_Ws:
5243  typ=-1;
5244  case ringorder_wp:
5245  case ringorder_Wp:
5246  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5247  R->block0[n] = last+1;
5248  for (i=2; i<iv->length(); i++)
5249  {
5250  R->wvhdl[n][i-2] = (*iv)[i];
5251  last++;
5252  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5253  }
5254  R->block1[n] = si_min(last,R->N);
5255  break;
5256  case ringorder_ls:
5257  case ringorder_ds:
5258  case ringorder_Ds:
5259  case ringorder_rs:
5260  typ=-1;
5261  case ringorder_lp:
5262  case ringorder_dp:
5263  case ringorder_Dp:
5264  case ringorder_rp:
5265  R->block0[n] = last+1;
5266  if (iv->length() == 3) last+=(*iv)[2];
5267  else last += (*iv)[0];
5268  R->block1[n] = si_min(last,R->N);
5269  if (rCheckIV(iv)) return TRUE;
5270  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5271  {
5272  if (weights[i]==0) weights[i]=typ;
5273  }
5274  break;
5275 
5276  case ringorder_s: // no 'rank' params!
5277  {
5278 
5279  if(iv->length() > 3)
5280  return TRUE;
5281 
5282  if(iv->length() == 3)
5283  {
5284  const int s = (*iv)[2];
5285  R->block0[n] = s;
5286  R->block1[n] = s;
5287  }
5288  break;
5289  }
5290  case ringorder_IS:
5291  {
5292  if(iv->length() != 3) return TRUE;
5293 
5294  const int s = (*iv)[2];
5295 
5296  if( 1 < s || s < -1 ) return TRUE;
5297 
5298  R->block0[n] = s;
5299  R->block1[n] = s;
5300  break;
5301  }
5302  case ringorder_S:
5303  case ringorder_c:
5304  case ringorder_C:
5305  {
5306  if (rCheckIV(iv)) return TRUE;
5307  break;
5308  }
5309  case ringorder_aa:
5310  case ringorder_a:
5311  {
5312  R->block0[n] = last+1;
5313  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5314  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5315  for (i=2; i<iv->length(); i++)
5316  {
5317  R->wvhdl[n][i-2]=(*iv)[i];
5318  last++;
5319  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5320  }
5321  last=R->block0[n]-1;
5322  break;
5323  }
5324  case ringorder_am:
5325  {
5326  R->block0[n] = last+1;
5327  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5328  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5329  if (R->block1[n]- R->block0[n]+2>=iv->length())
5330  WarnS("missing module weights");
5331  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5332  {
5333  R->wvhdl[n][i-2]=(*iv)[i];
5334  last++;
5335  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5336  }
5337  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5338  for (; i<iv->length(); i++)
5339  {
5340  R->wvhdl[n][i-1]=(*iv)[i];
5341  }
5342  last=R->block0[n]-1;
5343  break;
5344  }
5345  case ringorder_a64:
5346  {
5347  R->block0[n] = last+1;
5348  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5349  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5350  int64 *w=(int64 *)R->wvhdl[n];
5351  for (i=2; i<iv->length(); i++)
5352  {
5353  w[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_M:
5361  {
5362  int Mtyp=rTypeOfMatrixOrder(iv);
5363  if (Mtyp==0) return TRUE;
5364  if (Mtyp==-1) typ = -1;
5365 
5366  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5367  for (i=2; i<iv->length();i++)
5368  R->wvhdl[n][i-2]=(*iv)[i];
5369 
5370  R->block0[n] = last+1;
5371  last += (int)sqrt((double)(iv->length()-2));
5372  R->block1[n] = si_min(last,R->N);
5373  for(i=R->block1[n];i>=R->block0[n];i--)
5374  {
5375  if (weights[i]==0) weights[i]=typ;
5376  }
5377  break;
5378  }
5379 
5380  case ringorder_no:
5381  R->order[n] = ringorder_unspec;
5382  return TRUE;
5383 
5384  default:
5385  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5386  R->order[n] = ringorder_unspec;
5387  return TRUE;
5388  }
5389  }
5390  if (last>R->N)
5391  {
5392  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5393  R->N,last);
5394  return TRUE;
5395  }
5396  sl=sl->next;
5397  }
5398  // find OrdSgn:
5399  R->OrdSgn = 1;
5400  for(i=1;i<=R->N;i++)
5401  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5402  omFree(weights);
5403 
5404  // check for complete coverage
5405  while ( n >= 0 && (
5406  (R->order[n]==ringorder_c)
5407  || (R->order[n]==ringorder_C)
5408  || (R->order[n]==ringorder_s)
5409  || (R->order[n]==ringorder_S)
5410  || (R->order[n]==ringorder_IS)
5411  )) n--;
5412 
5413  assume( n >= 0 );
5414 
5415  if (R->block1[n] != R->N)
5416  {
5417  if (((R->order[n]==ringorder_dp) ||
5418  (R->order[n]==ringorder_ds) ||
5419  (R->order[n]==ringorder_Dp) ||
5420  (R->order[n]==ringorder_Ds) ||
5421  (R->order[n]==ringorder_rp) ||
5422  (R->order[n]==ringorder_rs) ||
5423  (R->order[n]==ringorder_lp) ||
5424  (R->order[n]==ringorder_ls))
5425  &&
5426  R->block0[n] <= R->N)
5427  {
5428  R->block1[n] = R->N;
5429  }
5430  else
5431  {
5432  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5433  R->N,R->block1[n]);
5434  return TRUE;
5435  }
5436  }
5437  return FALSE;
5438 }
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:83
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:89
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:5056
#define assume(x)
Definition: mod2.h:394
const ring R
Definition: DebugPrint.cc:36
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:87
#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 5864 of file ipshell.cc.

5865 {
5866  ring R = rCopy0(org_ring);
5867  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
5868  int n = rBlocks(org_ring), i=0, j;
5869 
5870  /* names and number of variables-------------------------------------*/
5871  {
5872  int l=rv->listLength();
5873  if (l>MAX_SHORT)
5874  {
5875  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5876  goto rInitError;
5877  }
5878  R->N = l; /*rv->listLength();*/
5879  }
5880  omFree(R->names);
5881  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5882  if (rSleftvList2StringArray(rv, R->names))
5883  {
5884  WerrorS("name of ring variable expected");
5885  goto rInitError;
5886  }
5887 
5888  /* check names for subring in org_ring ------------------------- */
5889  {
5890  i=0;
5891 
5892  for(j=0;j<R->N;j++)
5893  {
5894  for(;i<org_ring->N;i++)
5895  {
5896  if (strcmp(org_ring->names[i],R->names[j])==0)
5897  {
5898  perm[i+1]=j+1;
5899  break;
5900  }
5901  }
5902  if (i>org_ring->N)
5903  {
5904  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5905  break;
5906  }
5907  }
5908  }
5909  //Print("perm=");
5910  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
5911  /* ordering -------------------------------------------------------------*/
5912 
5913  for(i=0;i<n;i++)
5914  {
5915  int min_var=-1;
5916  int max_var=-1;
5917  for(j=R->block0[i];j<=R->block1[i];j++)
5918  {
5919  if (perm[j]>0)
5920  {
5921  if (min_var==-1) min_var=perm[j];
5922  max_var=perm[j];
5923  }
5924  }
5925  if (min_var!=-1)
5926  {
5927  //Print("block %d: old %d..%d, now:%d..%d\n",
5928  // i,R->block0[i],R->block1[i],min_var,max_var);
5929  R->block0[i]=min_var;
5930  R->block1[i]=max_var;
5931  if (R->wvhdl[i]!=NULL)
5932  {
5933  omFree(R->wvhdl[i]);
5934  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
5935  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
5936  {
5937  if (perm[j]>0)
5938  {
5939  R->wvhdl[i][perm[j]-R->block0[i]]=
5940  org_ring->wvhdl[i][j-org_ring->block0[i]];
5941  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
5942  }
5943  }
5944  }
5945  }
5946  else
5947  {
5948  if(R->block0[i]>0)
5949  {
5950  //Print("skip block %d\n",i);
5951  R->order[i]=ringorder_unspec;
5952  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
5953  R->wvhdl[i]=NULL;
5954  }
5955  //else Print("keep block %d\n",i);
5956  }
5957  }
5958  i=n-1;
5959  while(i>0)
5960  {
5961  // removed unneded blocks
5962  if(R->order[i-1]==ringorder_unspec)
5963  {
5964  for(j=i;j<=n;j++)
5965  {
5966  R->order[j-1]=R->order[j];
5967  R->block0[j-1]=R->block0[j];
5968  R->block1[j-1]=R->block1[j];
5969  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
5970  R->wvhdl[j-1]=R->wvhdl[j];
5971  }
5972  R->order[n]=ringorder_unspec;
5973  n--;
5974  }
5975  i--;
5976  }
5977  n=rBlocks(org_ring)-1;
5978  while (R->order[n]==0) n--;
5979  while (R->order[n]==ringorder_unspec) n--;
5980  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
5981  if (R->block1[n] != R->N)
5982  {
5983  if (((R->order[n]==ringorder_dp) ||
5984  (R->order[n]==ringorder_ds) ||
5985  (R->order[n]==ringorder_Dp) ||
5986  (R->order[n]==ringorder_Ds) ||
5987  (R->order[n]==ringorder_rp) ||
5988  (R->order[n]==ringorder_rs) ||
5989  (R->order[n]==ringorder_lp) ||
5990  (R->order[n]==ringorder_ls))
5991  &&
5992  R->block0[n] <= R->N)
5993  {
5994  R->block1[n] = R->N;
5995  }
5996  else
5997  {
5998  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
5999  R->N,R->block1[n],n);
6000  return NULL;
6001  }
6002  }
6003  omFree(perm);
6004  // find OrdSgn:
6005  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6006  //for(i=1;i<=R->N;i++)
6007  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6008  //omFree(weights);
6009  // Complete the initialization
6010  if (rComplete(R,1))
6011  goto rInitError;
6012 
6013  rTest(R);
6014 
6015  if (rv != NULL) rv->CleanUp();
6016 
6017  return R;
6018 
6019  // error case:
6020  rInitError:
6021  if (R != NULL) rDelete(R);
6022  if (rv != NULL) rv->CleanUp();
6023  return NULL;
6024 }
const short MAX_SHORT
Definition: ipshell.cc:5476
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5440
opposite of ls
Definition: ring.h:100
int listLength()
Definition: subexpr.cc:61
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:3351
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:1321
const ring R
Definition: DebugPrint.cc:36
#define rTest(r)
Definition: ring.h:778
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:333
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:89
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:92
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 4441 of file ipshell.cc.

4442 {
4443  sleftv tmp;
4444  memset(&tmp,0,sizeof(tmp));
4445  tmp.rtyp=INT_CMD;
4446  /* tmp.data = (void *)0; -- done by memset */
4447 
4448  return semicProc3(res,u,v,&tmp);
4449 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4401
int rtyp
Definition: subexpr.h:92

§ semicProc3()

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

Definition at line 4401 of file ipshell.cc.

4402 {
4403  semicState state;
4404  BOOLEAN qh=(((int)(long)w->Data())==1);
4405 
4406  // -----------------
4407  // check arguments
4408  // -----------------
4409 
4410  lists l1 = (lists)u->Data( );
4411  lists l2 = (lists)v->Data( );
4412 
4413  if( (state=list_is_spectrum( l1 ))!=semicOK )
4414  {
4415  WerrorS( "first argument is not a spectrum" );
4416  list_error( state );
4417  }
4418  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4419  {
4420  WerrorS( "second argument is not a spectrum" );
4421  list_error( state );
4422  }
4423  else
4424  {
4425  spectrum s1= spectrumFromList( l1 );
4426  spectrum s2= spectrumFromList( l2 );
4427 
4428  res->rtyp = INT_CMD;
4429  if (qh)
4430  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4431  else
4432  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4433  }
4434 
4435  // -----------------
4436  // check status
4437  // -----------------
4438 
4439  return (state!=semicOK);
4440 }
Definition: tok.h:95
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3274
void list_error(semicState state)
Definition: ipshell.cc:3358
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4143
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3324
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1138
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 4318 of file ipshell.cc.

4319 {
4320  semicState state;
4321 
4322  // -----------------
4323  // check arguments
4324  // -----------------
4325 
4326  lists l1 = (lists)first->Data( );
4327  lists l2 = (lists)second->Data( );
4328 
4329  if( (state=list_is_spectrum( l1 )) != semicOK )
4330  {
4331  WerrorS( "first argument is not a spectrum:" );
4332  list_error( state );
4333  }
4334  else if( (state=list_is_spectrum( l2 )) != semicOK )
4335  {
4336  WerrorS( "second argument is not a spectrum:" );
4337  list_error( state );
4338  }
4339  else
4340  {
4341  spectrum s1= spectrumFromList ( l1 );
4342  spectrum s2= spectrumFromList ( l2 );
4343  spectrum sum( s1+s2 );
4344 
4345  result->rtyp = LIST_CMD;
4346  result->data = (char*)(getList(sum));
4347  }
4348 
4349  return (state!=semicOK);
4350 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3274
void list_error(semicState state)
Definition: ipshell.cc:3358
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3286
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4143
semicState
Definition: ipshell.cc:3324
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1138
Definition: tok.h:117

§ spectrumCompute()

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

Definition at line 3700 of file ipshell.cc.

3701 {
3702  int i;
3703 
3704  #ifdef SPECTRUM_DEBUG
3705  #ifdef SPECTRUM_PRINT
3706  #ifdef SPECTRUM_IOSTREAM
3707  cout << "spectrumCompute\n";
3708  if( fast==0 ) cout << " no optimization" << endl;
3709  if( fast==1 ) cout << " weight optimization" << endl;
3710  if( fast==2 ) cout << " symmetry optimization" << endl;
3711  #else
3712  fprintf( stdout,"spectrumCompute\n" );
3713  if( fast==0 ) fprintf( stdout," no optimization\n" );
3714  if( fast==1 ) fprintf( stdout," weight optimization\n" );
3715  if( fast==2 ) fprintf( stdout," symmetry optimization\n" );
3716  #endif
3717  #endif
3718  #endif
3719 
3720  // ----------------------
3721  // check if h is zero
3722  // ----------------------
3723 
3724  if( h==(poly)NULL )
3725  {
3726  return spectrumZero;
3727  }
3728 
3729  // ----------------------------------
3730  // check if h has a constant term
3731  // ----------------------------------
3732 
3733  if( hasConstTerm( h, currRing ) )
3734  {
3735  return spectrumBadPoly;
3736  }
3737 
3738  // --------------------------------
3739  // check if h has a linear term
3740  // --------------------------------
3741 
3742  if( hasLinearTerm( h, currRing ) )
3743  {
3744  *L = (lists)omAllocBin( slists_bin);
3745  (*L)->Init( 1 );
3746  (*L)->m[0].rtyp = INT_CMD; // milnor number
3747  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3748 
3749  return spectrumNoSingularity;
3750  }
3751 
3752  // ----------------------------------
3753  // compute the jacobi ideal of (h)
3754  // ----------------------------------
3755 
3756  ideal J = NULL;
3757  J = idInit( rVar(currRing),1 );
3758 
3759  #ifdef SPECTRUM_DEBUG
3760  #ifdef SPECTRUM_PRINT
3761  #ifdef SPECTRUM_IOSTREAM
3762  cout << "\n computing the Jacobi ideal...\n";
3763  #else
3764  fprintf( stdout,"\n computing the Jacobi ideal...\n" );
3765  #endif
3766  #endif
3767  #endif
3768 
3769  for( i=0; i<rVar(currRing); i++ )
3770  {
3771  J->m[i] = pDiff( h,i+1); //j );
3772 
3773  #ifdef SPECTRUM_DEBUG
3774  #ifdef SPECTRUM_PRINT
3775  #ifdef SPECTRUM_IOSTREAM
3776  cout << " ";
3777  #else
3778  fprintf( stdout," " );
3779  #endif
3780  pWrite( J->m[i] );
3781  #endif
3782  #endif
3783  }
3784 
3785  // --------------------------------------------
3786  // compute a standard basis stdJ of jac(h)
3787  // --------------------------------------------
3788 
3789  #ifdef SPECTRUM_DEBUG
3790  #ifdef SPECTRUM_PRINT
3791  #ifdef SPECTRUM_IOSTREAM
3792  cout << endl;
3793  cout << " computing a standard basis..." << endl;
3794  #else
3795  fprintf( stdout,"\n" );
3796  fprintf( stdout," computing a standard basis...\n" );
3797  #endif
3798  #endif
3799  #endif
3800 
3801  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3802  idSkipZeroes( stdJ );
3803 
3804  #ifdef SPECTRUM_DEBUG
3805  #ifdef SPECTRUM_PRINT
3806  for( i=0; i<IDELEMS(stdJ); i++ )
3807  {
3808  #ifdef SPECTRUM_IOSTREAM
3809  cout << " ";
3810  #else
3811  fprintf( stdout," " );
3812  #endif
3813 
3814  pWrite( stdJ->m[i] );
3815  }
3816  #endif
3817  #endif
3818 
3819  idDelete( &J );
3820 
3821  // ------------------------------------------
3822  // check if the h has a singularity
3823  // ------------------------------------------
3824 
3825  if( hasOne( stdJ, currRing ) )
3826  {
3827  // -------------------------------
3828  // h is smooth in the origin
3829  // return only the Milnor number
3830  // -------------------------------
3831 
3832  *L = (lists)omAllocBin( slists_bin);
3833  (*L)->Init( 1 );
3834  (*L)->m[0].rtyp = INT_CMD; // milnor number
3835  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3836 
3837  return spectrumNoSingularity;
3838  }
3839 
3840  // ------------------------------------------
3841  // check if the singularity h is isolated
3842  // ------------------------------------------
3843 
3844  for( i=rVar(currRing); i>0; i-- )
3845  {
3846  if( hasAxis( stdJ,i, currRing )==FALSE )
3847  {
3848  return spectrumNotIsolated;
3849  }
3850  }
3851 
3852  // ------------------------------------------
3853  // compute the highest corner hc of stdJ
3854  // ------------------------------------------
3855 
3856  #ifdef SPECTRUM_DEBUG
3857  #ifdef SPECTRUM_PRINT
3858  #ifdef SPECTRUM_IOSTREAM
3859  cout << "\n computing the highest corner...\n";
3860  #else
3861  fprintf( stdout,"\n computing the highest corner...\n" );
3862  #endif
3863  #endif
3864  #endif
3865 
3866  poly hc = (poly)NULL;
3867 
3868  scComputeHC( stdJ,currRing->qideal, 0,hc );
3869 
3870  if( hc!=(poly)NULL )
3871  {
3872  pGetCoeff(hc) = nInit(1);
3873 
3874  for( i=rVar(currRing); i>0; i-- )
3875  {
3876  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3877  }
3878  pSetm( hc );
3879  }
3880  else
3881  {
3882  return spectrumNoHC;
3883  }
3884 
3885  #ifdef SPECTRUM_DEBUG
3886  #ifdef SPECTRUM_PRINT
3887  #ifdef SPECTRUM_IOSTREAM
3888  cout << " ";
3889  #else
3890  fprintf( stdout," " );
3891  #endif
3892  pWrite( hc );
3893  #endif
3894  #endif
3895 
3896  // ----------------------------------------
3897  // compute the Newton polygon nph of h
3898  // ----------------------------------------
3899 
3900  #ifdef SPECTRUM_DEBUG
3901  #ifdef SPECTRUM_PRINT
3902  #ifdef SPECTRUM_IOSTREAM
3903  cout << "\n computing the newton polygon...\n";
3904  #else
3905  fprintf( stdout,"\n computing the newton polygon...\n" );
3906  #endif
3907  #endif
3908  #endif
3909 
3910  newtonPolygon nph( h, currRing );
3911 
3912  #ifdef SPECTRUM_DEBUG
3913  #ifdef SPECTRUM_PRINT
3914  cout << nph;
3915  #endif
3916  #endif
3917 
3918  // -----------------------------------------------
3919  // compute the weight corner wc of (stdj,nph)
3920  // -----------------------------------------------
3921 
3922  #ifdef SPECTRUM_DEBUG
3923  #ifdef SPECTRUM_PRINT
3924  #ifdef SPECTRUM_IOSTREAM
3925  cout << "\n computing the weight corner...\n";
3926  #else
3927  fprintf( stdout,"\n computing the weight corner...\n" );
3928  #endif
3929  #endif
3930  #endif
3931 
3932  poly wc = ( fast==0 ? pCopy( hc ) :
3933  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
3934  /* fast==2 */computeWC( nph,
3935  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
3936 
3937  #ifdef SPECTRUM_DEBUG
3938  #ifdef SPECTRUM_PRINT
3939  #ifdef SPECTRUM_IOSTREAM
3940  cout << " ";
3941  #else
3942  fprintf( stdout," " );
3943  #endif
3944  pWrite( wc );
3945  #endif
3946  #endif
3947 
3948  // -------------
3949  // compute NF
3950  // -------------
3951 
3952  #ifdef SPECTRUM_DEBUG
3953  #ifdef SPECTRUM_PRINT
3954  #ifdef SPECTRUM_IOSTREAM
3955  cout << "\n computing NF...\n" << endl;
3956  #else
3957  fprintf( stdout,"\n computing NF...\n" );
3958  #endif
3959  #endif
3960  #endif
3961 
3962  spectrumPolyList NF( &nph );
3963 
3964  computeNF( stdJ,hc,wc,&NF, currRing );
3965 
3966  #ifdef SPECTRUM_DEBUG
3967  #ifdef SPECTRUM_PRINT
3968  cout << NF;
3969  #ifdef SPECTRUM_IOSTREAM
3970  cout << endl;
3971  #else
3972  fprintf( stdout,"\n" );
3973  #endif
3974  #endif
3975  #endif
3976 
3977  // ----------------------------
3978  // compute the spectrum of h
3979  // ----------------------------
3980 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
3981 
3982  return spectrumStateFromList(NF, L, fast );
3983 }
#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:3459
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 4074 of file ipshell.cc.

4075 {
4076  spectrumState state = spectrumOK;
4077 
4078  // -------------------
4079  // check consistency
4080  // -------------------
4081 
4082  // check for a local polynomial ring
4083 
4084  if( currRing->OrdSgn != -1 )
4085  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4086  // or should we use:
4087  //if( !ringIsLocal( ) )
4088  {
4089  WerrorS( "only works for local orderings" );
4090  state = spectrumWrongRing;
4091  }
4092  else if( currRing->qideal != NULL )
4093  {
4094  WerrorS( "does not work in quotient rings" );
4095  state = spectrumWrongRing;
4096  }
4097  else
4098  {
4099  lists L = (lists)NULL;
4100  int flag = 2; // symmetric optimization
4101 
4102  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4103 
4104  if( state==spectrumOK )
4105  {
4106  result->rtyp = LIST_CMD;
4107  result->data = (char*)L;
4108  }
4109  else
4110  {
4111  spectrumPrintError(state);
4112  }
4113  }
4114 
4115  return (state!=spectrumOK);
4116 }
spectrumState
Definition: ipshell.cc:3440
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:89
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:3992
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3700
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1138
Definition: tok.h:117
polyrec * poly
Definition: hilb.h:10

§ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3274 of file ipshell.cc.

3275 {
3276  spectrum result;
3277  copy_deep( result, l );
3278  return result;
3279 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3250
return result
Definition: facAbsBiFact.cc:76

§ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 3992 of file ipshell.cc.

3993 {
3994  switch( state )
3995  {
3996  case spectrumZero:
3997  WerrorS( "polynomial is zero" );
3998  break;
3999  case spectrumBadPoly:
4000  WerrorS( "polynomial has constant term" );
4001  break;
4002  case spectrumNoSingularity:
4003  WerrorS( "not a singularity" );
4004  break;
4005  case spectrumNotIsolated:
4006  WerrorS( "the singularity is not isolated" );
4007  break;
4008  case spectrumNoHC:
4009  WerrorS( "highest corner cannot be computed" );
4010  break;
4011  case spectrumDegenerate:
4012  WerrorS( "principal part is degenerate" );
4013  break;
4014  case spectrumOK:
4015  break;
4016 
4017  default:
4018  WerrorS( "unknown error occurred" );
4019  break;
4020  }
4021 }
void WerrorS(const char *s)
Definition: feFopen.cc:24

§ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4023 of file ipshell.cc.

4024 {
4025  spectrumState state = spectrumOK;
4026 
4027  // -------------------
4028  // check consistency
4029  // -------------------
4030 
4031  // check for a local ring
4032 
4033  if( !ringIsLocal(currRing ) )
4034  {
4035  WerrorS( "only works for local orderings" );
4036  state = spectrumWrongRing;
4037  }
4038 
4039  // no quotient rings are allowed
4040 
4041  else if( currRing->qideal != NULL )
4042  {
4043  WerrorS( "does not work in quotient rings" );
4044  state = spectrumWrongRing;
4045  }
4046  else
4047  {
4048  lists L = (lists)NULL;
4049  int flag = 1; // weight corner optimization is safe
4050 
4051  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4052 
4053  if( state==spectrumOK )
4054  {
4055  result->rtyp = LIST_CMD;
4056  result->data = (char*)L;
4057  }
4058  else
4059  {
4060  spectrumPrintError(state);
4061  }
4062  }
4063 
4064  return (state!=spectrumOK);
4065 }
spectrumState
Definition: ipshell.cc:3440
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:89
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:3992
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3700
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1138
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 3459 of file ipshell.cc.

3460 {
3461  spectrumPolyNode **node = &speclist.root;
3463 
3464  poly f,tmp;
3465  int found,cmp;
3466 
3467  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3468  ( fast==2 ? 2 : 1 ) );
3469 
3470  Rational weight_prev( 0,1 );
3471 
3472  int mu = 0; // the milnor number
3473  int pg = 0; // the geometrical genus
3474  int n = 0; // number of different spectral numbers
3475  int z = 0; // number of spectral number equal to smax
3476 
3477  while( (*node)!=(spectrumPolyNode*)NULL &&
3478  ( fast==0 || (*node)->weight<=smax ) )
3479  {
3480  // ---------------------------------------
3481  // determine the first normal form which
3482  // contains the monomial node->mon
3483  // ---------------------------------------
3484 
3485  found = FALSE;
3486  search = *node;
3487 
3488  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3489  {
3490  if( search->nf!=(poly)NULL )
3491  {
3492  f = search->nf;
3493 
3494  do
3495  {
3496  // --------------------------------
3497  // look for (*node)->mon in f
3498  // --------------------------------
3499 
3500  cmp = pCmp( (*node)->mon,f );
3501 
3502  if( cmp<0 )
3503  {
3504  f = pNext( f );
3505  }
3506  else if( cmp==0 )
3507  {
3508  // -----------------------------
3509  // we have found a normal form
3510  // -----------------------------
3511 
3512  found = TRUE;
3513 
3514  // normalize coefficient
3515 
3516  number inv = nInvers( pGetCoeff( f ) );
3517  pMult_nn( search->nf,inv );
3518  nDelete( &inv );
3519 
3520  // exchange normal forms
3521 
3522  tmp = (*node)->nf;
3523  (*node)->nf = search->nf;
3524  search->nf = tmp;
3525  }
3526  }
3527  while( cmp<0 && f!=(poly)NULL );
3528  }
3529  search = search->next;
3530  }
3531 
3532  if( found==FALSE )
3533  {
3534  // ------------------------------------------------
3535  // the weight of node->mon is a spectrum number
3536  // ------------------------------------------------
3537 
3538  mu++;
3539 
3540  if( (*node)->weight<=(Rational)1 ) pg++;
3541  if( (*node)->weight==smax ) z++;
3542  if( (*node)->weight>weight_prev ) n++;
3543 
3544  weight_prev = (*node)->weight;
3545  node = &((*node)->next);
3546  }
3547  else
3548  {
3549  // -----------------------------------------------
3550  // determine all other normal form which contain
3551  // the monomial node->mon
3552  // replace for node->mon its normal form
3553  // -----------------------------------------------
3554 
3555  while( search!=(spectrumPolyNode*)NULL )
3556  {
3557  if( search->nf!=(poly)NULL )
3558  {
3559  f = search->nf;
3560 
3561  do
3562  {
3563  // --------------------------------
3564  // look for (*node)->mon in f
3565  // --------------------------------
3566 
3567  cmp = pCmp( (*node)->mon,f );
3568 
3569  if( cmp<0 )
3570  {
3571  f = pNext( f );
3572  }
3573  else if( cmp==0 )
3574  {
3575  search->nf = pSub( search->nf,
3576  ppMult_nn( (*node)->nf,pGetCoeff( f ) ) );
3577  pNorm( search->nf );
3578  }
3579  }
3580  while( cmp<0 && f!=(poly)NULL );
3581  }
3582  search = search->next;
3583  }
3584  speclist.delete_node( node );
3585  }
3586 
3587  }
3588 
3589  // --------------------------------------------------------
3590  // fast computation exploits the symmetry of the spectrum
3591  // --------------------------------------------------------
3592 
3593  if( fast==2 )
3594  {
3595  mu = 2*mu - z;
3596  n = ( z > 0 ? 2*n - 1 : 2*n );
3597  }
3598 
3599  // --------------------------------------------------------
3600  // compute the spectrum numbers with their multiplicities
3601  // --------------------------------------------------------
3602 
3603  intvec *nom = new intvec( n );
3604  intvec *den = new intvec( n );
3605  intvec *mult = new intvec( n );
3606 
3607  int count = 0;
3608  int multiplicity = 1;
3609 
3610  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3611  ( fast==0 || search->weight<=smax );
3612  search=search->next )
3613  {
3614  if( search->next==(spectrumPolyNode*)NULL ||
3615  search->weight<search->next->weight )
3616  {
3617  (*nom) [count] = search->weight.get_num_si( );
3618  (*den) [count] = search->weight.get_den_si( );
3619  (*mult)[count] = multiplicity;
3620 
3621  multiplicity=1;
3622  count++;
3623  }
3624  else
3625  {
3626  multiplicity++;
3627  }
3628  }
3629 
3630  // --------------------------------------------------------
3631  // fast computation exploits the symmetry of the spectrum
3632  // --------------------------------------------------------
3633 
3634  if( fast==2 )
3635  {
3636  int n1,n2;
3637  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3638  {
3639  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3640  (*den) [n2] = (*den)[n1];
3641  (*mult)[n2] = (*mult)[n1];
3642  }
3643  }
3644 
3645  // -----------------------------------
3646  // test if the spectrum is symmetric
3647  // -----------------------------------
3648 
3649  if( fast==0 || fast==1 )
3650  {
3651  int symmetric=TRUE;
3652 
3653  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3654  {
3655  if( (*mult)[n1]!=(*mult)[n2] ||
3656  (*den) [n1]!= (*den)[n2] ||
3657  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3658  {
3659  symmetric = FALSE;
3660  }
3661  }
3662 
3663  if( symmetric==FALSE )
3664  {
3665  // ---------------------------------------------
3666  // the spectrum is not symmetric => degenerate
3667  // principal part
3668  // ---------------------------------------------
3669 
3670  *L = (lists)omAllocBin( slists_bin);
3671  (*L)->Init( 1 );
3672  (*L)->m[0].rtyp = INT_CMD; // milnor number
3673  (*L)->m[0].data = (void*)(long)mu;
3674 
3675  return spectrumDegenerate;
3676  }
3677  }
3678 
3679  *L = (lists)omAllocBin( slists_bin);
3680 
3681  (*L)->Init( 6 );
3682 
3683  (*L)->m[0].rtyp = INT_CMD; // milnor number
3684  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3685  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3686  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3687  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3688  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3689 
3690  (*L)->m[0].data = (void*)(long)mu;
3691  (*L)->m[1].data = (void*)(long)pg;
3692  (*L)->m[2].data = (void*)(long)n;
3693  (*L)->m[3].data = (void*)nom;
3694  (*L)->m[4].data = (void*)den;
3695  (*L)->m[5].data = (void*)mult;
3696 
3697  return spectrumOK;
3698 }
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
f
Definition: cfModGcd.cc:4022
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
#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 4360 of file ipshell.cc.

4361 {
4362  semicState state;
4363 
4364  // -----------------
4365  // check arguments
4366  // -----------------
4367 
4368  lists l = (lists)first->Data( );
4369  int k = (int)(long)second->Data( );
4370 
4371  if( (state=list_is_spectrum( l ))!=semicOK )
4372  {
4373  WerrorS( "first argument is not a spectrum" );
4374  list_error( state );
4375  }
4376  else if( k < 0 )
4377  {
4378  WerrorS( "second argument should be positive" );
4379  state = semicMulNegative;
4380  }
4381  else
4382  {
4383  spectrum s= spectrumFromList( l );
4384  spectrum product( k*s );
4385 
4386  result->rtyp = LIST_CMD;
4387  result->data = (char*)getList(product);
4388  }
4389 
4390  return (state!=semicOK);
4391 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3274
void list_error(semicState state)
Definition: ipshell.cc:3358
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:3286
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4143
semicState
Definition: ipshell.cc:3324
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1138
Definition: tok.h:117
int l
Definition: cfEzgcd.cc:94

§ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3061 of file ipshell.cc.

3062 {
3063  sleftv tmp;
3064  memset(&tmp,0,sizeof(tmp));
3065  tmp.rtyp=INT_CMD;
3066  tmp.data=(void *)1;
3067  return syBetti2(res,u,&tmp);
3068 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
void * data
Definition: subexpr.h:89
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3038
int rtyp
Definition: subexpr.h:92

§ syBetti2()

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

Definition at line 3038 of file ipshell.cc.

3039 {
3040  syStrategy syzstr=(syStrategy)u->Data();
3041 
3042  BOOLEAN minim=(int)(long)w->Data();
3043  int row_shift=0;
3044  int add_row_shift=0;
3045  intvec *weights=NULL;
3046  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3047  if (ww!=NULL)
3048  {
3049  weights=ivCopy(ww);
3050  add_row_shift = ww->min_in();
3051  (*weights) -= add_row_shift;
3052  }
3053 
3054  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3055  //row_shift += add_row_shift;
3056  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3057  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3058 
3059  return FALSE;
3060 }
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
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:89
Definition: intvec.h:14
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#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:1138
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 3146 of file ipshell.cc.

3147 {
3148  int typ0;
3150 
3151  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3152  if (fr != NULL)
3153  {
3154 
3155  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3156  for (int i=result->length-1;i>=0;i--)
3157  {
3158  if (fr[i]!=NULL)
3159  result->fullres[i] = idCopy(fr[i]);
3160  }
3161  result->list_length=result->length;
3162  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3163  }
3164  else
3165  {
3166  omFreeSize(result, sizeof(ssyStrategy));
3167  result = NULL;
3168  }
3169  return result;
3170 }
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 3073 of file ipshell.cc.

3074 {
3075  resolvente fullres = syzstr->fullres;
3076  resolvente minres = syzstr->minres;
3077 
3078  const int length = syzstr->length;
3079 
3080  if ((fullres==NULL) && (minres==NULL))
3081  {
3082  if (syzstr->hilb_coeffs==NULL)
3083  { // La Scala
3084  fullres = syReorder(syzstr->res, length, syzstr);
3085  }
3086  else
3087  { // HRES
3088  minres = syReorder(syzstr->orderedRes, length, syzstr);
3089  syKillEmptyEntres(minres, length);
3090  }
3091  }
3092 
3093  resolvente tr;
3094  int typ0=IDEAL_CMD;
3095 
3096  if (minres!=NULL)
3097  tr = minres;
3098  else
3099  tr = fullres;
3100 
3101  resolvente trueres=NULL; intvec ** w=NULL;
3102 
3103  if (length>0)
3104  {
3105  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3106  for (int i=(length)-1;i>=0;i--)
3107  {
3108  if (tr[i]!=NULL)
3109  {
3110  trueres[i] = idCopy(tr[i]);
3111  }
3112  }
3113  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3114  typ0 = MODUL_CMD;
3115  if (syzstr->weights!=NULL)
3116  {
3117  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3118  for (int i=length-1;i>=0;i--)
3119  {
3120  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3121  }
3122  }
3123  }
3124 
3125  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3126  w, add_row_shift);
3127 
3128  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3129 
3130  if (toDel)
3131  syKillComputation(syzstr);
3132  else
3133  {
3134  if( fullres != NULL && syzstr->fullres == NULL )
3135  syzstr->fullres = fullres;
3136 
3137  if( minres != NULL && syzstr->minres == NULL )
3138  syzstr->minres = minres;
3139  }
3140  return li;
3141 }
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 3175 of file ipshell.cc.

3176 {
3177  int typ0;
3179 
3180  resolvente fr = liFindRes(li,&(result->length),&typ0);
3181  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3182  for (int i=result->length-1;i>=0;i--)
3183  {
3184  if (fr[i]!=NULL)
3185  result->minres[i] = idCopy(fr[i]);
3186  }
3187  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3188  return result;
3189 }
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:996
const char * Name()
Definition: subexpr.h:121
void Print(leftv store=NULL, int spaces=0)
Called by type_cmd (e.g. "r;") or as default in jPRINT.
Definition: subexpr.cc:73
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:1138
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 5476 of file ipshell.cc.