Macros | Enumerations | Functions | Variables
ipshell.cc File Reference
#include <kernel/mod2.h>
#include <omalloc/omalloc.h>
#include <factory/factory.h>
#include <misc/auxiliary.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/fast_maps.h>
#include <Singular/number2.h>
#include <coeffs/bigintmat.h>
#include "libparse.h"

Go to the source code of this file.

Macros

#define FAST_MAP
 
#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 r, 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 (leftv h, const coeffs C)
 
void rDecomposeRing (leftv h, const coeffs C)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 
lists rDecompose (const ring r)
 
void rComposeC (lists L, ring R)
 
void rComposeRing (lists L, ring R)
 
static void rRenameVars (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, BOOLEAN toDel)
 
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)
 
BOOLEAN rSleftvList2StringArray (sleftv *sl, char **p)
 
ring rInit (sleftv *pn, sleftv *rv, sleftv *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 res, leftv a, int op, leftv proc)
 
BOOLEAN iiApplyIDEAL (leftv res, leftv a, int op, leftv proc)
 
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

#define BREAK_LINE_LENGTH   80

Definition at line 980 of file ipshell.cc.

#define FAST_MAP

Definition at line 74 of file ipshell.cc.

Enumeration Type Documentation

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

3299 {
3300  semicOK,
3302 
3305 
3312 
3317 
3323 
3326 
3329 
3330 } semicState;
semicState
Definition: ipshell.cc:3298
Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3414 of file ipshell.cc.

Function Documentation

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3224 of file ipshell.cc.

3225 {
3226  spec.mu = (int)(long)(l->m[0].Data( ));
3227  spec.pg = (int)(long)(l->m[1].Data( ));
3228  spec.n = (int)(long)(l->m[2].Data( ));
3229 
3230  spec.copy_new( spec.n );
3231 
3232  intvec *num = (intvec*)l->m[3].Data( );
3233  intvec *den = (intvec*)l->m[4].Data( );
3234  intvec *mul = (intvec*)l->m[5].Data( );
3235 
3236  for( int i=0; i<spec.n; i++ )
3237  {
3238  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3239  spec.w[i] = (*mul)[i];
3240  }
3241 }
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:16
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:1111
int * w
Definition: semic.h:71
int exprlist_length ( leftv  v)

Definition at line 559 of file ipshell.cc.

560 {
561  int rc = 0;
562  while (v!=NULL)
563  {
564  switch (v->Typ())
565  {
566  case INT_CMD:
567  case POLY_CMD:
568  case VECTOR_CMD:
569  case NUMBER_CMD:
570  rc++;
571  break;
572  case INTVEC_CMD:
573  case INTMAT_CMD:
574  rc += ((intvec *)(v->Data()))->length();
575  break;
576  case MATRIX_CMD:
577  case IDEAL_CMD:
578  case MODUL_CMD:
579  {
580  matrix mm = (matrix)(v->Data());
581  rc += mm->rows() * mm->cols();
582  }
583  break;
584  case LIST_CMD:
585  rc+=((lists)v->Data())->nr+1;
586  break;
587  default:
588  rc++;
589  }
590  v = v->next;
591  }
592  return rc;
593 }
int & rows()
Definition: matpol.h:24
Definition: tok.h:85
int Typ()
Definition: subexpr.cc:969
Definition: intvec.h:16
ip_smatrix * matrix
Definition: tok.h:88
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:1111
Definition: tok.h:96
lists getList ( spectrum spec)

Definition at line 3260 of file ipshell.cc.

3261 {
3263 
3264  L->Init( 6 );
3265 
3266  intvec *num = new intvec( spec.n );
3267  intvec *den = new intvec( spec.n );
3268  intvec *mult = new intvec( spec.n );
3269 
3270  for( int i=0; i<spec.n; i++ )
3271  {
3272  (*num) [i] = spec.s[i].get_num_si( );
3273  (*den) [i] = spec.s[i].get_den_si( );
3274  (*mult)[i] = spec.w[i];
3275  }
3276 
3277  L->m[0].rtyp = INT_CMD; // milnor number
3278  L->m[1].rtyp = INT_CMD; // geometrical genus
3279  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3280  L->m[3].rtyp = INTVEC_CMD; // numerators
3281  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3282  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3283 
3284  L->m[0].data = (void*)(long)spec.mu;
3285  L->m[1].data = (void*)(long)spec.pg;
3286  L->m[2].data = (void*)(long)spec.n;
3287  L->m[3].data = (void*)num;
3288  L->m[4].data = (void*)den;
3289  L->m[5].data = (void*)mult;
3290 
3291  return L;
3292 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
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:16
int i
Definition: cfEzgcd.cc:123
Definition: tok.h:88
int n
Definition: semic.h:69
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
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
BOOLEAN iiApply ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6293 of file ipshell.cc.

6294 {
6295  memset(res,0,sizeof(sleftv));
6296  res->rtyp=a->Typ();
6297  switch (res->rtyp /*a->Typ()*/)
6298  {
6299  case INTVEC_CMD:
6300  case INTMAT_CMD:
6301  return iiApplyINTVEC(res,a,op,proc);
6302  case BIGINTMAT_CMD:
6303  return iiApplyBIGINTMAT(res,a,op,proc);
6304  case IDEAL_CMD:
6305  case MODUL_CMD:
6306  case MATRIX_CMD:
6307  return iiApplyIDEAL(res,a,op,proc);
6308  case LIST_CMD:
6309  return iiApplyLIST(res,a,op,proc);
6310  }
6311  WerrorS("first argument to `apply` must allow an index");
6312  return TRUE;
6313 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
BOOLEAN iiApplyBIGINTMAT(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6251
BOOLEAN iiApplyIDEAL(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6256
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:969
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6261
Definition: tok.h:88
int rtyp
Definition: subexpr.h:92
Definition: tok.h:96
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6219
BOOLEAN iiApplyBIGINTMAT ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6251 of file ipshell.cc.

6252 {
6253  WerrorS("not implemented");
6254  return TRUE;
6255 }
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
BOOLEAN iiApplyIDEAL ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6256 of file ipshell.cc.

6257 {
6258  WerrorS("not implemented");
6259  return TRUE;
6260 }
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
BOOLEAN iiApplyINTVEC ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6219 of file ipshell.cc.

6220 {
6221  intvec *aa=(intvec*)a->Data();
6222  sleftv tmp_out;
6223  sleftv tmp_in;
6224  leftv curr=res;
6225  BOOLEAN bo=FALSE;
6226  for(int i=0;i<aa->length(); i++)
6227  {
6228  memset(&tmp_in,0,sizeof(tmp_in));
6229  tmp_in.rtyp=INT_CMD;
6230  tmp_in.data=(void*)(long)(*aa)[i];
6231  if (proc==NULL)
6232  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6233  else
6234  bo=jjPROC(&tmp_out,proc,&tmp_in);
6235  if (bo)
6236  {
6237  res->CleanUp(currRing);
6238  Werror("apply fails at index %d",i+1);
6239  return TRUE;
6240  }
6241  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6242  else
6243  {
6244  curr->next=(leftv)omAllocBin(sleftv_bin);
6245  curr=curr->next;
6246  memcpy(curr,&tmp_out,sizeof(tmp_out));
6247  }
6248  }
6249  return FALSE;
6250 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:85
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8330
#define FALSE
Definition: auxiliary.h:140
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1607
#define TRUE
Definition: auxiliary.h:144
int length() const
Definition: intvec.h:86
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:12
Definition: intvec.h:16
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 rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1111
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiApplyLIST ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6261 of file ipshell.cc.

6262 {
6263  lists aa=(lists)a->Data();
6264  sleftv tmp_out;
6265  sleftv tmp_in;
6266  leftv curr=res;
6267  BOOLEAN bo=FALSE;
6268  for(int i=0;i<=aa->nr; i++)
6269  {
6270  memset(&tmp_in,0,sizeof(tmp_in));
6271  tmp_in.Copy(&(aa->m[i]));
6272  if (proc==NULL)
6273  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6274  else
6275  bo=jjPROC(&tmp_out,proc,&tmp_in);
6276  tmp_in.CleanUp();
6277  if (bo)
6278  {
6279  res->CleanUp(currRing);
6280  Werror("apply fails at index %d",i+1);
6281  return TRUE;
6282  }
6283  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6284  else
6285  {
6286  curr->next=(leftv)omAllocBin(sleftv_bin);
6287  curr=curr->next;
6288  memcpy(curr,&tmp_out,sizeof(tmp_out));
6289  }
6290  }
6291  return FALSE;
6292 }
#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:8330
#define FALSE
Definition: auxiliary.h:140
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1607
#define TRUE
Definition: auxiliary.h:144
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:12
void Copy(leftv e)
Definition: subexpr.cc:657
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:321
void * Data()
Definition: subexpr.cc:1111
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiARROW ( leftv  r,
char *  a,
char *  s 
)

Definition at line 6342 of file ipshell.cc.

6343 {
6344  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6345  // find end of s:
6346  int end_s=strlen(s);
6347  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6348  s[end_s+1]='\0';
6349  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6350  sprintf(name,"%s->%s",a,s);
6351  // find start of last expression
6352  int start_s=end_s-1;
6353  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6354  if (start_s<0) // ';' not found
6355  {
6356  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6357  }
6358  else // s[start_s] is ';'
6359  {
6360  s[start_s]='\0';
6361  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6362  }
6363  memset(r,0,sizeof(*r));
6364  // now produce procinfo for PROC_CMD:
6365  r->data = (void *)omAlloc0Bin(procinfo_bin);
6366  ((procinfo *)(r->data))->language=LANG_NONE;
6367  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6368  ((procinfo *)r->data)->data.s.body=ss;
6369  omFree(name);
6370  r->rtyp=PROC_CMD;
6371  //r->rtyp=STRING_CMD;
6372  //r->data=ss;
6373  return FALSE;
6374 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
const poly a
Definition: syzextra.cc:212
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int line, long pos, BOOLEAN pstatic)
Definition: iplib.cc:978
#define FALSE
Definition: auxiliary.h:140
#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
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
char name(const Variable &v)
Definition: variable.h:95
int rtyp
Definition: subexpr.h:92
BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6376 of file ipshell.cc.

6377 {
6378  int t=arg->Typ();
6379  char* ring_name=omStrDup((char*)r->Name());
6380  if ((t==RING_CMD) ||(t==QRING_CMD))
6381  {
6382  sleftv tmp;
6383  memset(&tmp,0,sizeof(tmp));
6384  tmp.rtyp=IDHDL;
6385  tmp.data=(char*)rDefault(ring_name);
6386  if (tmp.data!=NULL)
6387  {
6388  BOOLEAN b=iiAssign(&tmp,arg);
6389  if (b) return TRUE;
6390  rSetHdl(ggetid(ring_name));
6391  omFree(ring_name);
6392  return FALSE;
6393  }
6394  else
6395  return TRUE;
6396  }
6397  #ifdef SINGULAR_4_1
6398  else if (t==CRING_CMD)
6399  {
6400  sleftv tmp;
6401  sleftv n;
6402  memset(&n,0,sizeof(n));
6403  n.name=ring_name;
6404  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6405  if (iiAssign(&tmp,arg)) return TRUE;
6406  //Print("create %s\n",r->Name());
6407  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6408  return FALSE;
6409  }
6410  #endif
6411  //Print("create %s\n",r->Name());
6412  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6413  return TRUE;// not handled -> error for now
6414 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:969
const char * Name()
Definition: subexpr.h:121
#define IDHDL
Definition: tok.h:35
idhdl rDefault(const char *s)
Definition: ipshell.cc:1528
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:1119
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
Definition: tok.h:126
void rSetHdl(idhdl h)
Definition: ipshell.cc:4979
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1782
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1174 of file ipshell.cc.

1175 {
1176  // <string1...stringN>,<proc>
1177  // known: args!=NULL, l>=1
1178  int l=args->listLength();
1179  int ll=0;
1180  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1181  if (ll!=(l-1)) return FALSE;
1182  leftv h=args;
1183  short *t=(short*)omAlloc(l*sizeof(short));
1184  t[0]=l-1;
1185  int b;
1186  int i;
1187  for(i=1;i<l;i++,h=h->next)
1188  {
1189  if (h->Typ()!=STRING_CMD)
1190  {
1191  omFree(t);
1192  Werror("arg %d is not a string",i);
1193  return TRUE;
1194  }
1195  int tt;
1196  b=IsCmd((char *)h->Data(),tt);
1197  if(b) t[i]=tt;
1198  else
1199  {
1200  omFree(t);
1201  Werror("arg %d is not a type name",i);
1202  return TRUE;
1203  }
1204  }
1205  if (h->Typ()!=PROC_CMD)
1206  {
1207  omFree(t);
1208  Werror("last arg (%d) is not a proc",i);
1209  return TRUE;
1210  }
1211  b=iiCheckTypes(iiCurrArgs,t,0);
1212  omFree(t);
1213  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1214  {
1215  BOOLEAN err;
1216  //Print("branchTo: %s\n",h->Name());
1217  iiCurrProc=(idhdl)h->data;
1219  if( pi->data.s.body==NULL )
1220  {
1222  if (pi->data.s.body==NULL) return TRUE;
1223  }
1224  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1225  {
1226  currPack=pi->pack;
1229  //Print("set pack=%s\n",IDID(currPackHdl));
1230  }
1231  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1233  if (iiCurrArgs!=NULL)
1234  {
1235  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1236  iiCurrArgs->CleanUp();
1238  iiCurrArgs=NULL;
1239  }
1240  return 2-err;
1241  }
1242  return FALSE;
1243 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN exitBuffer(feBufferTypes typ)
Definition: fevoices.cc:241
#define IDHDL
Definition: tok.h:35
idhdl iiCurrProc
Definition: ipshell.cc:85
#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:322
#define IDPROC(a)
Definition: ipid.h:139
#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:6434
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:84
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
idhdl packFindHdl(package r)
Definition: ipid.cc:732
void iiCheckPack(package &p)
Definition: ipshell.cc:1512
#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:131
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:199
int l
Definition: cfEzgcd.cc:94
utypes data
Definition: idrec.h:40
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8739
#define Warn
Definition: emacs.cc:80
void iiCheckPack ( package p)

Definition at line 1512 of file ipshell.cc.

1513 {
1514  if (p==basePack) return;
1515 
1516  idhdl t=basePack->idroot;
1517 
1518  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1519 
1520  if (t==NULL)
1521  {
1522  WarnS("package not found\n");
1523  p=basePack;
1524  }
1525  return;
1526 }
return P p
Definition: myNF.cc:203
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
idhdl next
Definition: idrec.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
BOOLEAN iiCheckRing ( int  i)

Definition at line 1468 of file ipshell.cc.

1469 {
1470  if (currRing==NULL)
1471  {
1472  #ifdef SIQ
1473  if (siq<=0)
1474  {
1475  #endif
1476  if (RingDependend(i))
1477  {
1478  WerrorS("no ring active");
1479  return TRUE;
1480  }
1481  #ifdef SIQ
1482  }
1483  #endif
1484  }
1485  return FALSE;
1486 }
#define FALSE
Definition: auxiliary.h:140
BOOLEAN siq
Definition: subexpr.cc:58
#define TRUE
Definition: auxiliary.h:144
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:12
int RingDependend(int t)
Definition: gentable.cc:23
int i
Definition: cfEzgcd.cc:123
#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 (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 6434 of file ipshell.cc.

6435 {
6436  if (args==NULL)
6437  {
6438  if (type_list[0]==0) return TRUE;
6439  else
6440  {
6441  if (report) WerrorS("no arguments expected");
6442  return FALSE;
6443  }
6444  }
6445  int l=args->listLength();
6446  if (l!=(int)type_list[0])
6447  {
6448  if (report) iiReportTypes(0,l,type_list);
6449  return FALSE;
6450  }
6451  for(int i=1;i<=l;i++,args=args->next)
6452  {
6453  short t=type_list[i];
6454  if (t!=ANY_TYPE)
6455  {
6456  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6457  || (t!=args->Typ()))
6458  {
6459  if (report) iiReportTypes(i,args->Typ(),type_list);
6460  return FALSE;
6461  }
6462  }
6463  }
6464  return TRUE;
6465 }
#define ANY_TYPE
Definition: tok.h:34
#define FALSE
Definition: auxiliary.h:140
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define IDHDL
Definition: tok.h:35
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6416
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int l
Definition: cfEzgcd.cc:94
static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 861 of file ipshell.cc.

862 {
863  int i;
864  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
865 
866  for (i=0; i<l; i++)
867  if (r[i]!=NULL) res[i]=idCopy(r[i]);
868  return res;
869 }
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:73
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
void iiDebug ( )

Definition at line 981 of file ipshell.cc.

982 {
983 #ifdef HAVE_SDB
984  sdb_flags=1;
985 #endif
986  Print("\n-- break point in %s --\n",VoiceName());
988  char * s;
990  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
991  loop
992  {
993  memset(s,0,80);
995  if (s[BREAK_LINE_LENGTH-1]!='\0')
996  {
997  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
998  }
999  else
1000  break;
1001  }
1002  if (*s=='\n')
1003  {
1005  }
1006 #if MDEBUG
1007  else if(strncmp(s,"cont;",5)==0)
1008  {
1010  }
1011 #endif /* MDEBUG */
1012  else
1013  {
1014  strcat( s, "\n;~\n");
1015  newBuffer(s,BT_execute);
1016  }
1017 }
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:140
#define TRUE
Definition: auxiliary.h:144
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:979
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:980
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171
int iiDeclCommand ( leftv  sy,
leftv  name,
int  lev,
int  t,
idhdl root,
BOOLEAN  isring,
BOOLEAN  init_b 
)

Definition at line 1119 of file ipshell.cc.

1120 {
1121  BOOLEAN res=FALSE;
1122  const char *id = name->name;
1123 
1124  memset(sy,0,sizeof(sleftv));
1125  if ((name->name==NULL)||(isdigit(name->name[0])))
1126  {
1127  WerrorS("object to declare is not a name");
1128  res=TRUE;
1129  }
1130  else
1131  {
1132  if (TEST_V_ALLWARN
1133  && (name->rtyp!=0)
1134  && (name->rtyp!=IDHDL)
1135  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1136  {
1137  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1139  }
1140  {
1141  sy->data = (char *)enterid(id,lev,t,root,init_b);
1142  }
1143  if (sy->data!=NULL)
1144  {
1145  sy->rtyp=IDHDL;
1146  currid=sy->name=IDID((idhdl)sy->data);
1147  // name->name=NULL; /* used in enterid */
1148  //sy->e = NULL;
1149  if (name->next!=NULL)
1150  {
1152  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1153  }
1154  }
1155  else res=TRUE;
1156  }
1157  name->CleanUp();
1158  return res;
1159 }
#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:121
#define FALSE
Definition: auxiliary.h:140
char * filename
Definition: fevoices.h:62
#define TRUE
Definition: auxiliary.h:144
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:35
const char * currid
Definition: grammar.cc:172
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:120
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:1119
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
Voice * currentVoice
Definition: fevoices.cc:57
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80
BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1161 of file ipshell.cc.

1162 {
1163  attr at=NULL;
1164  if (iiCurrProc!=NULL)
1165  at=iiCurrProc->attribute->get("default_arg");
1166  if (at==NULL)
1167  return FALSE;
1168  sleftv tmp;
1169  memset(&tmp,0,sizeof(sleftv));
1170  tmp.rtyp=at->atyp;
1171  tmp.data=at->CopyA();
1172  return iiAssign(p,&tmp);
1173 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: attrib.h:15
#define FALSE
Definition: auxiliary.h:140
idhdl iiCurrProc
Definition: ipshell.cc:85
void * data
Definition: subexpr.h:89
void * CopyA()
Definition: subexpr.cc:1932
#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:1782
BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1388 of file ipshell.cc.

1389 {
1390  BOOLEAN nok=FALSE;
1391  leftv r=v;
1392  while (v!=NULL)
1393  {
1394  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1395  {
1396  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1397  nok=TRUE;
1398  }
1399  else
1400  {
1401  if(iiInternalExport(v, toLev))
1402  {
1403  r->CleanUp();
1404  return TRUE;
1405  }
1406  }
1407  v=v->next;
1408  }
1409  r->CleanUp();
1410  return nok;
1411 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
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:1280
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiExport ( leftv  v,
int  toLev,
package  pack 
)

Definition at line 1414 of file ipshell.cc.

1415 {
1416 #ifdef SINGULAR_4_1
1417  if ((pack==basePack)&&(pack!=currPack))
1418  { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1419 #endif
1420  BOOLEAN nok=FALSE;
1421  leftv rv=v;
1422  while (v!=NULL)
1423  {
1424  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1425  )
1426  {
1427  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1428  nok=TRUE;
1429  }
1430  else
1431  {
1432  idhdl old=pack->idroot->get( v->name,toLev);
1433  if (old!=NULL)
1434  {
1435  if ((pack==currPack) && (old==(idhdl)v->data))
1436  {
1437  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1438  break;
1439  }
1440  else if (IDTYP(old)==v->Typ())
1441  {
1442  if (BVERBOSE(V_REDEFINE))
1443  {
1444  Warn("redefining %s",IDID(old));
1445  }
1446  v->name=omStrDup(v->name);
1447  killhdl2(old,&(pack->idroot),currRing);
1448  }
1449  else
1450  {
1451  rv->CleanUp();
1452  return TRUE;
1453  }
1454  }
1455  //Print("iiExport: pack=%s\n",IDID(root));
1456  if(iiInternalExport(v, toLev, pack))
1457  {
1458  rv->CleanUp();
1459  return TRUE;
1460  }
1461  }
1462  v=v->next;
1463  }
1464  rv->CleanUp();
1465  return nok;
1466 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:969
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:12
#define IDTYP(a)
Definition: ipid.h:118
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
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:1280
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
#define V_REDEFINE
Definition: options.h:43
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1488 of file ipshell.cc.

1489 {
1490  int i;
1491  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1492  poly po=NULL;
1494  {
1495  scComputeHC(I,currRing->qideal,ak,po);
1496  if (po!=NULL)
1497  {
1498  pGetCoeff(po)=nInit(1);
1499  for (i=rVar(currRing); i>0; i--)
1500  {
1501  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1502  }
1503  pSetComp(po,ak);
1504  pSetm(po);
1505  }
1506  }
1507  else
1508  po=pOne();
1509  return po;
1510 }
#define pSetm(p)
Definition: polys.h:241
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
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:173
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#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:286
#define rHasLocalOrMixedOrdering_currRing()
Definition: ring.h:760
#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
static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1280 of file ipshell.cc.

1281 {
1282  idhdl h=(idhdl)v->data;
1283  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1284  if (IDLEV(h)==0)
1285  {
1286  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1287  }
1288  else
1289  {
1290  h=IDROOT->get(v->name,toLev);
1291  idhdl *root=&IDROOT;
1292  if ((h==NULL)&&(currRing!=NULL))
1293  {
1294  h=currRing->idroot->get(v->name,toLev);
1295  root=&currRing->idroot;
1296  }
1297  BOOLEAN keepring=FALSE;
1298  if ((h!=NULL)&&(IDLEV(h)==toLev))
1299  {
1300  if (IDTYP(h)==v->Typ())
1301  {
1302  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1303  && (v->Data()==IDDATA(h)))
1304  {
1305  IDRING(h)->ref++;
1306  keepring=TRUE;
1307  IDLEV(h)=toLev;
1308  //WarnS("keepring");
1309  return FALSE;
1310  }
1311  if (BVERBOSE(V_REDEFINE))
1312  {
1313  Warn("redefining %s",IDID(h));
1314  }
1315 #ifdef USE_IILOCALRING
1316  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1317 #else
1319  while (p->next!=NULL) p=p->next;
1320  if ((p->cRing==IDRING(h)) && (!keepring))
1321  {
1322  p->cRing=NULL;
1323  p->cRingHdl=NULL;
1324  }
1325 #endif
1326  killhdl2(h,root,currRing);
1327  }
1328  else
1329  {
1330  return TRUE;
1331  }
1332  }
1333  h=(idhdl)v->data;
1334  IDLEV(h)=toLev;
1335  if (keepring) IDRING(h)->ref--;
1337  //Print("export %s\n",IDID(h));
1338  }
1339  return FALSE;
1340 }
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
proclevel * procstack
Definition: ipid.cc:58
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:969
idhdl cRingHdl
Definition: ipid.h:60
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:12
#define IDTYP(a)
Definition: ipid.h:118
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
Definition: ipid.h:56
const char * name
Definition: subexpr.h:88
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:88
proclevel * next
Definition: ipid.h:59
idrec * idhdl
Definition: ring.h:18
#define IDLEV(a)
Definition: ipid.h:120
#define BVERBOSE(a)
Definition: options.h:33
ring * iiLocalRing
Definition: iplib.cc:525
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
ring cRing
Definition: ipid.h:61
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:126
#define IDDATA(a)
Definition: ipid.h:125
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
#define V_REDEFINE
Definition: options.h:43
#define Warn
Definition: emacs.cc:80
BOOLEAN iiInternalExport ( leftv  v,
int  toLev,
package  rootpack 
)

Definition at line 1342 of file ipshell.cc.

1343 {
1344  idhdl h=(idhdl)v->data;
1345  if(h==NULL)
1346  {
1347  Warn("'%s': no such identifier\n", v->name);
1348  return FALSE;
1349  }
1350  package frompack=v->req_packhdl;
1351  if (frompack==NULL) frompack=currPack;
1352  if ((RingDependend(IDTYP(h)))
1353  || ((IDTYP(h)==LIST_CMD)
1354  && (lRingDependend(IDLIST(h)))
1355  )
1356  )
1357  {
1358  //Print("// ==> Ringdependent set nesting to 0\n");
1359  return (iiInternalExport(v, toLev));
1360  }
1361  else
1362  {
1363  IDLEV(h)=toLev;
1364  v->req_packhdl=rootpack;
1365  if (h==frompack->idroot)
1366  {
1367  frompack->idroot=h->next;
1368  }
1369  else
1370  {
1371  idhdl hh=frompack->idroot;
1372  while ((hh!=NULL) && (hh->next!=h))
1373  hh=hh->next;
1374  if ((hh!=NULL) && (hh->next==h))
1375  hh->next=h->next;
1376  else
1377  {
1378  Werror("`%s` not found",v->Name());
1379  return TRUE;
1380  }
1381  }
1382  h->next=rootpack->idroot;
1383  rootpack->idroot=h;
1384  }
1385  return FALSE;
1386 }
#define IDLIST(a)
Definition: ipid.h:136
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
const char * Name()
Definition: subexpr.h:121
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
#define IDTYP(a)
Definition: ipid.h:118
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:120
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1280
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
Definition: tok.h:96
static Poly * h
Definition: janet.cc:978
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
void iiMakeResolv ( resolvente  r,
int  length,
int  rlen,
char *  name,
int  typ0,
intvec **  weights 
)

Definition at line 772 of file ipshell.cc.

774 {
775  lists L=liMakeResolv(r,length,rlen,typ0,weights);
776  int i=0;
777  idhdl h;
778  char * s=(char *)omAlloc(strlen(name)+5);
779 
780  while (i<=L->nr)
781  {
782  sprintf(s,"%s(%d)",name,i+1);
783  if (i==0)
784  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
785  else
786  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
787  if (h!=NULL)
788  {
789  h->data.uideal=(ideal)L->m[i].data;
790  h->attribute=L->m[i].attribute;
792  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
793  }
794  else
795  {
796  idDelete((ideal *)&(L->m[i].data));
797  Warn("cannot define %s",s);
798  }
799  //L->m[i].data=NULL;
800  //L->m[i].rtyp=0;
801  //L->m[i].attribute=NULL;
802  i++;
803  }
804  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
806  omFreeSize((ADDRESS)s,strlen(name)+5);
807 }
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:31
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
#define FALSE
Definition: auxiliary.h:140
#define V_DEF_RES
Definition: options.h:48
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:161
#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:12
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
#define BVERBOSE(a)
Definition: options.h:33
int nr
Definition: lists.h:43
char name(const Variable &v)
Definition: variable.h:95
#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:216
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
leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 622 of file ipshell.cc.

623 {
624  idhdl w,r;
625  leftv v;
626  int i;
627  nMapFunc nMap;
628 
629  r=IDROOT->get(theMap->preimage,myynest);
630  if ((currPack!=basePack)
631  &&((r==NULL) || ((r->typ != RING_CMD) && (r->typ != QRING_CMD))))
632  r=basePack->idroot->get(theMap->preimage,myynest);
633  if ((r==NULL) && (currRingHdl!=NULL)
634  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
635  {
636  r=currRingHdl;
637  }
638  if ((r!=NULL) && ((r->typ == RING_CMD) || (r->typ== QRING_CMD)))
639  {
640  ring src_ring=IDRING(r);
641  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
642  {
643  Werror("can not map from ground field of %s to current ground field",
644  theMap->preimage);
645  return NULL;
646  }
647  if (IDELEMS(theMap)<src_ring->N)
648  {
649  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
650  IDELEMS(theMap)*sizeof(poly),
651  (src_ring->N)*sizeof(poly));
652  for(i=IDELEMS(theMap);i<src_ring->N;i++)
653  theMap->m[i]=NULL;
654  IDELEMS(theMap)=src_ring->N;
655  }
656  if (what==NULL)
657  {
658  WerrorS("argument of a map must have a name");
659  }
660  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
661  {
662  char *save_r=NULL;
664  sleftv tmpW;
665  memset(&tmpW,0,sizeof(sleftv));
666  tmpW.rtyp=IDTYP(w);
667  if (tmpW.rtyp==MAP_CMD)
668  {
669  tmpW.rtyp=IDEAL_CMD;
670  save_r=IDMAP(w)->preimage;
671  IDMAP(w)->preimage=0;
672  }
673  tmpW.data=IDDATA(w);
674  // check overflow
675  BOOLEAN overflow=FALSE;
676  if ((tmpW.rtyp==IDEAL_CMD)
677  || (tmpW.rtyp==MODUL_CMD)
678  || (tmpW.rtyp==MAP_CMD))
679  {
680  ideal id=(ideal)tmpW.data;
681  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
682  {
683  if (theMap->m[j]!=NULL)
684  {
685  long deg_monexp=pTotaldegree(theMap->m[j]);
686  for(int i=IDELEMS(id)-1;i>=0;i--)
687  {
688  poly p=id->m[i];
689  if ((p!=NULL) && (p_Totaldegree(p,src_ring)!=0) &&
690  ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)p_Totaldegree(p,src_ring)/2)))
691  {
692  overflow=TRUE;
693  break;
694  }
695  }
696  }
697  }
698  }
699  else if (tmpW.rtyp==POLY_CMD)
700  {
701  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
702  {
703  if (theMap->m[j]!=NULL)
704  {
705  long deg_monexp=pTotaldegree(theMap->m[j]);
706  poly p=(poly)tmpW.data;
707  if ((p!=NULL) && (p_Totaldegree(p,src_ring)!=0) &&
708  ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)p_Totaldegree(p,src_ring)/2)))
709  {
710  overflow=TRUE;
711  break;
712  }
713  }
714  }
715  }
716  if (overflow)
717  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
718 #if 0
719  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
720  {
721  v->rtyp=tmpW.rtyp;
722  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
723  }
724  else
725 #endif
726  {
727 #ifdef FAST_MAP
728  if ((tmpW.rtyp==IDEAL_CMD) && (nMap == ndCopyMap)
729 #ifdef HAVE_PLURAL
730  && (!rIsPluralRing(currRing))
731 #endif
732  )
733  {
734  v->rtyp=IDEAL_CMD;
735  char *tmp = theMap->preimage;
736  theMap->preimage=(char*)1L;
737  // map gets 1 as its rank (as an ideal)
738  v->data=fast_map(IDIDEAL(w), src_ring, (ideal)theMap, currRing);
739  theMap->preimage=tmp; // map gets its preimage back
740  }
741  else
742 #endif
743  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
744  {
745  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
747  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
748  return NULL;
749  }
750  }
751  if (save_r!=NULL)
752  {
753  IDMAP(w)->preimage=save_r;
754  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
755  v->rtyp=MAP_CMD;
756  }
757  return v;
758  }
759  else
760  {
761  Werror("%s undefined in %s",what,theMap->preimage);
762  }
763  }
764  else
765  {
766  Werror("cannot find preimage %s",theMap->preimage);
767  }
768  return NULL;
769 }
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:121
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
number ndCopyMap(number a, const coeffs aRing, const coeffs r)
Definition: numbers.cc:239
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
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:54
#define IDIDEAL(a)
Definition: ipid.h:132
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1435
void * ADDRESS
Definition: auxiliary.h:161
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
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:12
#define IDTYP(a)
Definition: ipid.h:118
const ring r
Definition: syzextra.cc:208
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:253
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:72
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:720
#define IDMAP(a)
Definition: ipid.h:134
#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:17
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
const CanonicalForm & w
Definition: facAbsFact.cc:55
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
ideal fast_map(ideal map_id, ring map_r, ideal image_id, ring image_r)
Definition: fast_maps.cc:354
int typ
Definition: idrec.h:43
Definition: tok.h:126
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:125
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
int iiOpsTwoChar ( const char *  s)

Definition at line 125 of file ipshell.cc.

126 {
127 /* not handling: &&, ||, ** */
128  if (s[1]=='\0') return s[0];
129  else if (s[2]!='\0') return 0;
130  switch(s[0])
131  {
132  case '.': if (s[1]=='.') return DOTDOT;
133  else return 0;
134  case ':': if (s[1]==':') return COLONCOLON;
135  else return 0;
136  case '-': if (s[1]=='-') return MINUSMINUS;
137  else return 0;
138  case '+': if (s[1]=='+') return PLUSPLUS;
139  else return 0;
140  case '=': if (s[1]=='=') return EQUAL_EQUAL;
141  else return 0;
142  case '<': if (s[1]=='=') return LE;
143  else if (s[1]=='>') return NOTEQUAL;
144  else return 0;
145  case '>': if (s[1]=='=') return GE;
146  else return 0;
147  case '!': if (s[1]=='=') return NOTEQUAL;
148  else return 0;
149  }
150  return 0;
151 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: grammar.cc:271
Definition: grammar.cc:270
BOOLEAN iiParameter ( leftv  p)

Definition at line 1244 of file ipshell.cc.

1245 {
1246  if (iiCurrArgs==NULL)
1247  {
1248  if (strcmp(p->name,"#")==0)
1249  return iiDefaultParameter(p);
1250  Werror("not enough arguments for proc %s",VoiceName());
1251  p->CleanUp();
1252  return TRUE;
1253  }
1254  leftv h=iiCurrArgs;
1255  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1256  BOOLEAN is_default_list=FALSE;
1257  if (strcmp(p->name,"#")==0)
1258  {
1259  is_default_list=TRUE;
1260  rest=NULL;
1261  }
1262  else
1263  {
1264  h->next=NULL;
1265  }
1266  BOOLEAN res=iiAssign(p,h);
1267  if (is_default_list)
1268  {
1269  iiCurrArgs=NULL;
1270  }
1271  else
1272  {
1273  iiCurrArgs=rest;
1274  }
1275  h->CleanUp();
1277  return res;
1278 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
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:1161
leftv iiCurrArgs
Definition: ipshell.cc:84
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1782
int iiRegularity ( lists  L)

Definition at line 953 of file ipshell.cc.

954 {
955  int len,reg,typ0;
956 
957  resolvente r=liFindRes(L,&len,&typ0);
958 
959  if (r==NULL)
960  return -2;
961  intvec *weights=NULL;
962  int add_row_shift=0;
963  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
964  if (ww!=NULL)
965  {
966  weights=ivCopy(ww);
967  add_row_shift = ww->min_in();
968  (*weights) -= add_row_shift;
969  }
970  //Print("attr:%x\n",weights);
971 
972  intvec *dummy=syBetti(r,len,&reg,weights);
973  if (weights!=NULL) delete weights;
974  delete dummy;
975  omFreeSize((ADDRESS)r,len*sizeof(ideal));
976  return reg+1+add_row_shift;
977 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:114
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
Definition: tok.h:88
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:20
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:793
static void iiReportTypes ( int  nr,
int  t,
const short *  T 
)
static

Definition at line 6416 of file ipshell.cc.

6417 {
6418  char *buf=(char*)omAlloc(250);
6419  buf[0]='\0';
6420  if (nr==0)
6421  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6422  else
6423  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6424  for(int i=1;i<=T[0];i++)
6425  {
6426  strcat(buf,"`");
6427  strcat(buf,Tok2Cmdname(T[i]));
6428  strcat(buf,"`");
6429  if (i<T[0]) strcat(buf,",");
6430  }
6431  WerrorS(buf);
6432 }
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:128
static jList * T
Definition: janet.cc:37
BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6315 of file ipshell.cc.

6316 {
6317  // assume a: level
6318  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6319  {
6320  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6321  char assume_yylinebuf[80];
6322  strncpy(assume_yylinebuf,my_yylinebuf,79);
6323  int lev=(long)a->Data();
6324  int startlev=0;
6325  idhdl h=ggetid("assumeLevel");
6326  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6327  if(lev <=startlev)
6328  {
6329  BOOLEAN bo=b->Eval();
6330  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6331  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6332  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6333  }
6334  }
6335  b->CleanUp();
6336  a->CleanUp();
6337  return FALSE;
6338 }
int Eval()
Definition: subexpr.cc:1735
Definition: tok.h:85
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:969
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
#define IDTYP(a)
Definition: ipid.h:118
char my_yylinebuf[80]
Definition: febase.cc:48
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:124
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1111
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define TEST_V_ALLWARN
Definition: options.h:135
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
const char* iiTwoOps ( int  t)

Definition at line 92 of file ipshell.cc.

93 {
94  if (t<127)
95  {
96  static char ch[2];
97  switch (t)
98  {
99  case '&':
100  return "and";
101  case '|':
102  return "or";
103  default:
104  ch[0]=t;
105  ch[1]='\0';
106  return ch;
107  }
108  }
109  switch (t)
110  {
111  case COLONCOLON: return "::";
112  case DOTDOT: return "..";
113  //case PLUSEQUAL: return "+=";
114  //case MINUSEQUAL: return "-=";
115  case MINUSMINUS: return "--";
116  case PLUSPLUS: return "++";
117  case EQUAL_EQUAL: return "==";
118  case LE: return "<=";
119  case GE: return ">=";
120  case NOTEQUAL: return "<>";
121  default: return Tok2Cmdname(t);
122  }
123 }
Definition: grammar.cc:271
Definition: grammar.cc:270
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
BOOLEAN iiWRITE ( leftv  ,
leftv  v 
)

Definition at line 595 of file ipshell.cc.

596 {
597  sleftv vf;
598  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
599  {
600  WerrorS("link expected");
601  return TRUE;
602  }
603  si_link l=(si_link)vf.Data();
604  if (vf.next == NULL)
605  {
606  WerrorS("write: need at least two arguments");
607  return TRUE;
608  }
609 
610  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
611  if (b)
612  {
613  const char *s;
614  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
615  else s=sNoName;
616  Werror("cannot write to %s",s);
617  }
618  vf.CleanUp();
619  return b;
620 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:292
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
const char sNoName[]
Definition: subexpr.cc:56
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:969
leftv next
Definition: subexpr.h:87
Definition: tok.h:95
#define NULL
Definition: omList.c:10
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:358
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1111
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:199
int l
Definition: cfEzgcd.cc:94
BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 892 of file ipshell.cc.

893 {
894  sleftv tmp;
895  memset(&tmp,0,sizeof(tmp));
896  tmp.rtyp=INT_CMD;
897  tmp.data=(void *)1;
898  if ((u->Typ()==IDEAL_CMD)
899  || (u->Typ()==MODUL_CMD))
900  return jjBETTI2_ID(res,u,&tmp);
901  else
902  return jjBETTI2(res,u,&tmp);
903 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:85
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:926
int Typ()
Definition: subexpr.cc:969
void * data
Definition: subexpr.h:89
int rtyp
Definition: subexpr.h:92
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:905
BOOLEAN jjBETTI2 ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 926 of file ipshell.cc.

927 {
928  resolvente r;
929  int len;
930  int reg,typ0;
931  lists l=(lists)u->Data();
932 
933  intvec *weights=NULL;
934  int add_row_shift=0;
935  intvec *ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
936  if (ww!=NULL)
937  {
938  weights=ivCopy(ww);
939  add_row_shift = ww->min_in();
940  (*weights) -= add_row_shift;
941  }
942  //Print("attr:%x\n",weights);
943 
944  r=liFindRes(l,&len,&typ0);
945  if (r==NULL) return TRUE;
946  res->data=(char *)syBetti(r,len,&reg,weights,(int)(long)v->Data());
947  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
948  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
949  if (weights!=NULL) delete weights;
950  return FALSE;
951 }
sleftv * m
Definition: lists.h:45
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:85
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:114
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
Definition: tok.h:88
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
void * Data()
Definition: subexpr.cc:1111
ideal * resolvente
Definition: ideals.h:20
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:793
int l
Definition: cfEzgcd.cc:94
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN jjBETTI2_ID ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 905 of file ipshell.cc.

906 {
908  l->Init(1);
909  l->m[0].rtyp=u->Typ();
910  l->m[0].data=u->Data();
911  attr *a=u->Attribute();
912  if (a!=NULL)
913  l->m[0].attribute=*a;
914  sleftv tmp2;
915  memset(&tmp2,0,sizeof(tmp2));
916  tmp2.rtyp=LIST_CMD;
917  tmp2.data=(void *)l;
918  BOOLEAN r=jjBETTI2(res,&tmp2,v);
919  l->m[0].data=NULL;
920  l->m[0].attribute=NULL;
921  l->m[0].rtyp=DEF_CMD;
922  l->Clean();
923  return r;
924 }
#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:1366
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:926
int Typ()
Definition: subexpr.cc:969
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)
Definition: lists.h:66
#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:1111
Definition: tok.h:96
attr attribute
Definition: subexpr.h:90
omBin slists_bin
Definition: lists.cc:23
int BOOLEAN
Definition: auxiliary.h:131
int l
Definition: cfEzgcd.cc:94
BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3211 of file ipshell.cc.

3212 {
3213  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3214  return (res->data==NULL);
3215 }
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:12
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1398
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1111
static void jjINT_S_TO_ID ( int  n,
int *  e,
leftv  res 
)
static

Definition at line 6158 of file ipshell.cc.

6159 {
6160  if (n==0) n=1;
6161  ideal l=idInit(n,1);
6162  int i;
6163  poly p;
6164  for(i=rVar(currRing);i>0;i--)
6165  {
6166  if (e[i]>0)
6167  {
6168  n--;
6169  p=pOne();
6170  pSetExp(p,i,1);
6171  pSetm(p);
6172  l->m[n]=p;
6173  if (n==0) break;
6174  }
6175  }
6176  res->data=(char*)l;
6177  setFlag(res,FLAG_STD);
6178  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6179 }
#define pSetm(p)
Definition: polys.h:241
#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:540
void * ADDRESS
Definition: auxiliary.h:161
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:12
#define setFlag(A, F)
Definition: ipid.h:112
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:286
#define FLAG_STD
Definition: ipid.h:108
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
BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 871 of file ipshell.cc.

872 {
873  int len=0;
874  int typ0;
875  lists L=(lists)v->Data();
876  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
877  int add_row_shift = 0;
878  if (weights==NULL)
879  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
880  if (weights!=NULL) add_row_shift=weights->min_in();
881  resolvente rr=liFindRes(L,&len,&typ0);
882  if (rr==NULL) return TRUE;
883  resolvente r=iiCopyRes(rr,len);
884 
885  syMinimizeResolvente(r,len,0);
886  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
887  len++;
888  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
889  return FALSE;
890 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
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:144
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:114
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:861
Definition: tok.h:88
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:216
void * Data()
Definition: subexpr.cc:1111
ideal * resolvente
Definition: ideals.h:20
BOOLEAN jjPROC ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 1607 of file iparith.cc.

1608 {
1609  void *d;
1610  Subexpr e;
1611  int typ;
1612  BOOLEAN t=FALSE;
1613  idhdl tmp_proc=NULL;
1614  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1615  {
1616  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1617  tmp_proc->id="_auto";
1618  tmp_proc->typ=PROC_CMD;
1619  tmp_proc->data.pinf=(procinfo *)u->Data();
1620  tmp_proc->ref=1;
1621  d=u->data; u->data=(void *)tmp_proc;
1622  e=u->e; u->e=NULL;
1623  t=TRUE;
1624  typ=u->rtyp; u->rtyp=IDHDL;
1625  }
1626  BOOLEAN sl;
1627  if (u->req_packhdl==currPack)
1628  sl = iiMake_proc((idhdl)u->data,NULL,v);
1629  else
1630  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1631  if (t)
1632  {
1633  u->rtyp=typ;
1634  u->data=d;
1635  u->e=e;
1636  omFreeSize(tmp_proc,sizeof(idrec));
1637  }
1638  if (sl) return TRUE;
1639  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1640  iiRETURNEXPR.Init();
1641  return FALSE;
1642 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:140
sleftv iiRETURNEXPR
Definition: iplib.cc:527
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:144
void Init()
Definition: subexpr.h:108
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:35
void * data
Definition: subexpr.h:89
BOOLEAN iiMake_proc(idhdl pn, package pack, sleftv *sl)
Definition: iplib.cc:573
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:1111
int typ
Definition: idrec.h:43
const char * id
Definition: idrec.h:39
int BOOLEAN
Definition: auxiliary.h:131
#define omAlloc0(size)
Definition: omAllocDecl.h:211
utypes data
Definition: idrec.h:40
BOOLEAN jjRESULTANT ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 3204 of file ipshell.cc.

3205 {
3206  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3207  (poly)w->CopyD(), currRing);
3208  return errorreported;
3209 }
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:12
short errorreported
Definition: feFopen.cc:23
polyrec * poly
Definition: hilb.h:10
void * CopyD(int t)
Definition: subexpr.cc:676
BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6188 of file ipshell.cc.

6189 {
6190  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6191  ideal I=(ideal)u->Data();
6192  int i;
6193  int n=0;
6194  for(i=I->nrows*I->ncols-1;i>=0;i--)
6195  {
6196  int n0=pGetVariables(I->m[i],e);
6197  if (n0>n) n=n0;
6198  }
6199  jjINT_S_TO_ID(n,e,res);
6200  return FALSE;
6201 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6158
#define pGetVariables(p, e)
Definition: polys.h:222
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int i
Definition: cfEzgcd.cc:123
void * Data()
Definition: subexpr.cc:1111
#define omAlloc0(size)
Definition: omAllocDecl.h:211
BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6180 of file ipshell.cc.

6181 {
6182  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6183  int n=pGetVariables((poly)u->Data(),e);
6184  jjINT_S_TO_ID(n,e,res);
6185  return FALSE;
6186 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6158
#define pGetVariables(p, e)
Definition: polys.h:222
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1111
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211
ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 6113 of file ipshell.cc.

6114 {
6115  //test|=Sy_bit(OPT_PROT);
6116  idhdl save_ringhdl=currRingHdl;
6117  ideal resid;
6118  idhdl new_ring=NULL;
6119  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6120  {
6121  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
6122  new_ring=currRingHdl;
6124  }
6125  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6126  idhdl h=ggetid("groebner");
6127  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6128  u.name=IDID(h);
6129 
6130  sleftv res; memset(&res,0,sizeof(res));
6131  if(jjPROC(&res,&u,&v))
6132  {
6133  resid=kStd(F,Q,testHomog,NULL);
6134  }
6135  else
6136  {
6137  //printf("typ:%d\n",res.rtyp);
6138  resid=(ideal)(res.data);
6139  }
6140  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6141  if (new_ring!=NULL)
6142  {
6143  idhdl h=IDROOT;
6144  if (h==new_ring) IDROOT=h->next;
6145  else
6146  {
6147  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6148  if (h!=NULL) h->next=h->next->next;
6149  }
6150  if (h!=NULL) omFreeSize(h,sizeof(*h));
6151  }
6152  currRingHdl=save_ringhdl;
6153  u.CleanUp();
6154  v.CleanUp();
6155  return resid;
6156 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1607
#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:2221
#define Q
Definition: sirandom.c:25
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:35
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:12
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:126
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
static Poly * h
Definition: janet.cc:978
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
#define omStrDup(s)
Definition: omAllocDecl.h:263
void killlocals ( int  v)

Definition at line 385 of file ipshell.cc.

386 {
387  BOOLEAN changed=FALSE;
388  idhdl sh=currRingHdl;
389  ring cr=currRing;
390  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
391  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
392 
393  killlocals_rec(&(basePack->idroot),v,currRing);
394 
396  {
397  int t=iiRETURNEXPR.Typ();
398  if ((/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
399  || (/*iiRETURNEXPR.Typ()*/ t==QRING_CMD))
400  {
402  if (((ring)h->data)->idroot!=NULL)
403  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
404  }
405  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
406  {
407  leftv h=&iiRETURNEXPR;
408  changed |=killlocals_list(v,(lists)h->data);
409  }
410  }
411  if (changed)
412  {
414  if (currRingHdl==NULL)
415  currRing=NULL;
416  else if(cr!=currRing)
417  rChangeCurrRing(cr);
418  }
419 
420  if (myynest<=1) iiNoKeepRing=TRUE;
421  //Print("end killlocals >= %d\n",v);
422  //listall();
423 }
int iiRETURNEXPR_len
Definition: iplib.cc:528
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
sleftv iiRETURNEXPR
Definition: iplib.cc:527
#define TRUE
Definition: auxiliary.h:144
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:328
int Typ()
Definition: subexpr.cc:969
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:12
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:365
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:88
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1573
#define IDLEV(a)
Definition: ipid.h:120
void rChangeCurrRing(ring r)
Definition: polys.cc:14
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:126
Definition: tok.h:96
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:293
static void killlocals0 ( int  v,
idhdl localhdl,
const ring  r 
)
static

Definition at line 293 of file ipshell.cc.

294 {
295  idhdl h = *localhdl;
296  while (h!=NULL)
297  {
298  int vv;
299  //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
300  if ((vv=IDLEV(h))>0)
301  {
302  if (vv < v)
303  {
304  if (iiNoKeepRing)
305  {
306  //PrintS(" break\n");
307  return;
308  }
309  h = IDNEXT(h);
310  //PrintLn();
311  }
312  else //if (vv >= v)
313  {
314  idhdl nexth = IDNEXT(h);
315  killhdl2(h,localhdl,r);
316  h = nexth;
317  //PrintS("kill\n");
318  }
319  }
320  else
321  {
322  h = IDNEXT(h);
323  //PrintLn();
324  }
325  }
326 }
#define IDNEXT(a)
Definition: ipid.h:117
Definition: idrec.h:34
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
const ring r
Definition: syzextra.cc:208
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:88
#define IDLEV(a)
Definition: ipid.h:120
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
BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 365 of file ipshell.cc.

366 {
367  if (L==NULL) return FALSE;
368  BOOLEAN changed=FALSE;
369  int n=L->nr;
370  for(;n>=0;n--)
371  {
372  leftv h=&(L->m[n]);
373  void *d=h->data;
374  if (((h->rtyp==RING_CMD) || (h->rtyp==QRING_CMD))
375  && (((ring)d)->idroot!=NULL))
376  {
377  if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
378  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
379  }
380  else if (h->rtyp==LIST_CMD)
381  changed|=killlocals_list(v,(lists)d);
382  }
383  return changed;
384 }
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:140
#define TRUE
Definition: auxiliary.h:144
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:12
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:365
void rChangeCurrRing(ring r)
Definition: polys.cc:14
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:96
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:293
void killlocals_rec ( idhdl root,
int  v,
ring  r 
)

Definition at line 328 of file ipshell.cc.

329 {
330  idhdl h=*root;
331  while (h!=NULL)
332  {
333  if (IDLEV(h)>=v)
334  {
335 // Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
336  idhdl n=IDNEXT(h);
337  killhdl2(h,root,r);
338  h=n;
339  }
340  else if (IDTYP(h)==PACKAGE_CMD)
341  {
342  // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
343  if (IDPACKAGE(h)!=basePack)
344  killlocals_rec(&(IDRING(h)->idroot),v,r);
345  h=IDNEXT(h);
346  }
347  else if ((IDTYP(h)==RING_CMD)
348  ||(IDTYP(h)==QRING_CMD))
349  {
350  if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
351  // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
352  {
353  // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
354  killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
355  }
356  h=IDNEXT(h);
357  }
358  else
359  {
360 // Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
361  h=IDNEXT(h);
362  }
363  }
364 }
#define IDNEXT(a)
Definition: ipid.h:117
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:328
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
const ring r
Definition: syzextra.cc:208
#define IDLEV(a)
Definition: ipid.h:120
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:126
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3187 of file ipshell.cc.

3188 {
3189  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3190  if (res->data==NULL)
3191  res->data=(char *)new intvec(rVar(currRing));
3192  return FALSE;
3193 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
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:12
Definition: intvec.h:16
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1111
BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3165 of file ipshell.cc.

3166 {
3167  ideal F=(ideal)id->Data();
3168  intvec * iv = new intvec(rVar(currRing));
3169  polyset s;
3170  int sl, n, i;
3171  int *x;
3172 
3173  res->data=(char *)iv;
3174  s = F->m;
3175  sl = IDELEMS(F) - 1;
3176  n = rVar(currRing);
3177  double wNsqr = (double)2.0 / (double)n;
3179  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3180  wCall(s, sl, x, wNsqr, currRing);
3181  for (i = n; i!=0; i--)
3182  (*iv)[i-1] = x[i + n + 1];
3183  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3184  return FALSE;
3185 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:140
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
void * ADDRESS
Definition: auxiliary.h:161
#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:12
Definition: intvec.h:16
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:17
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:1111
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.c:82
static void list1 ( const char *  s,
idhdl  h,
BOOLEAN  c,
BOOLEAN  fullname 
)
static

Definition at line 153 of file ipshell.cc.

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

Definition at line 425 of file ipshell.cc.

426 {
427  package savePack=currPack;
428  idhdl h,start;
429  BOOLEAN all = typ<0;
430  BOOLEAN really_all=FALSE;
431 
432  if ( typ==0 )
433  {
434  if (strcmp(what,"all")==0)
435  {
436  if (currPack!=basePack)
437  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
438  really_all=TRUE;
439  h=basePack->idroot;
440  }
441  else
442  {
443  h = ggetid(what);
444  if (h!=NULL)
445  {
446  if (iterate) list1(prefix,h,TRUE,fullname);
447  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
448  if ((IDTYP(h)==RING_CMD)
449  || (IDTYP(h)==QRING_CMD)
450  //|| (IDTYP(h)==PACKE_CMD)
451  )
452  {
453  h=IDRING(h)->idroot;
454  }
455  else if(IDTYP(h)==PACKAGE_CMD)
456  {
457  currPack=IDPACKAGE(h);
458  //Print("list_cmd:package\n");
459  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
460  h=IDPACKAGE(h)->idroot;
461  }
462  else
463  {
464  currPack=savePack;
465  return;
466  }
467  }
468  else
469  {
470  Werror("%s is undefined",what);
471  currPack=savePack;
472  return;
473  }
474  }
475  all=TRUE;
476  }
477  else if (RingDependend(typ))
478  {
479  h = currRing->idroot;
480  }
481  else
482  h = IDROOT;
483  start=h;
484  while (h!=NULL)
485  {
486  if ((all
487  && (IDTYP(h)!=PROC_CMD)
488  &&(IDTYP(h)!=PACKAGE_CMD)
489  #ifdef SINGULAR_4_1
490  &&(IDTYP(h)!=CRING_CMD)
491  #endif
492  )
493  || (typ == IDTYP(h))
494  #ifdef SINGULAR_4_1
495  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
496  #else
497  || ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD))
498  #endif
499  )
500  {
501  list1(prefix,h,start==currRingHdl, fullname);
502  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
503  && (really_all || (all && (h==currRingHdl)))
504  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
505  {
506  list_cmd(0,IDID(h),"// ",FALSE);
507  }
508  if (IDTYP(h)==PACKAGE_CMD && really_all)
509  {
510  package save_p=currPack;
511  currPack=IDPACKAGE(h);
512  list_cmd(0,IDID(h),"// ",FALSE);
513  currPack=save_p;
514  }
515  }
516  h = IDNEXT(h);
517  }
518  currPack=savePack;
519 }
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
#define IDNEXT(a)
Definition: ipid.h:117
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:153
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
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:12
#define IDTYP(a)
Definition: ipid.h:118
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:425
idhdl currRingHdl
Definition: ipid.cc:65
void PrintS(const char *s)
Definition: reporter.cc:294
#define IDLEV(a)
Definition: ipid.h:120
Definition: tok.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
package currPack
Definition: ipid.cc:63
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
void list_error ( semicState  state)

Definition at line 3332 of file ipshell.cc.

3333 {
3334  switch( state )
3335  {
3336  case semicListTooShort:
3337  WerrorS( "the list is too short" );
3338  break;
3339  case semicListTooLong:
3340  WerrorS( "the list is too long" );
3341  break;
3342 
3344  WerrorS( "first element of the list should be int" );
3345  break;
3347  WerrorS( "second element of the list should be int" );
3348  break;
3350  WerrorS( "third element of the list should be int" );
3351  break;
3353  WerrorS( "fourth element of the list should be intvec" );
3354  break;
3356  WerrorS( "fifth element of the list should be intvec" );
3357  break;
3359  WerrorS( "sixth element of the list should be intvec" );
3360  break;
3361 
3362  case semicListNNegative:
3363  WerrorS( "first element of the list should be positive" );
3364  break;
3366  WerrorS( "wrong number of numerators" );
3367  break;
3369  WerrorS( "wrong number of denominators" );
3370  break;
3372  WerrorS( "wrong number of multiplicities" );
3373  break;
3374 
3375  case semicListMuNegative:
3376  WerrorS( "the Milnor number should be positive" );
3377  break;
3378  case semicListPgNegative:
3379  WerrorS( "the geometrical genus should be nonnegative" );
3380  break;
3381  case semicListNumNegative:
3382  WerrorS( "all numerators should be positive" );
3383  break;
3384  case semicListDenNegative:
3385  WerrorS( "all denominators should be positive" );
3386  break;
3387  case semicListMulNegative:
3388  WerrorS( "all multiplicities should be positive" );
3389  break;
3390 
3391  case semicListNotSymmetric:
3392  WerrorS( "it is not symmetric" );
3393  break;
3395  WerrorS( "it is not monotonous" );
3396  break;
3397 
3398  case semicListMilnorWrong:
3399  WerrorS( "the Milnor number is wrong" );
3400  break;
3401  case semicListPGWrong:
3402  WerrorS( "the geometrical genus is wrong" );
3403  break;
3404 
3405  default:
3406  WerrorS( "unspecific error" );
3407  break;
3408  }
3409 }
void WerrorS(const char *s)
Definition: feFopen.cc:24
semicState list_is_spectrum ( lists  l)

Definition at line 4117 of file ipshell.cc.

4118 {
4119  // -------------------
4120  // check list length
4121  // -------------------
4122 
4123  if( l->nr < 5 )
4124  {
4125  return semicListTooShort;
4126  }
4127  else if( l->nr > 5 )
4128  {
4129  return semicListTooLong;
4130  }
4131 
4132  // -------------
4133  // check types
4134  // -------------
4135 
4136  if( l->m[0].rtyp != INT_CMD )
4137  {
4139  }
4140  else if( l->m[1].rtyp != INT_CMD )
4141  {
4143  }
4144  else if( l->m[2].rtyp != INT_CMD )
4145  {
4147  }
4148  else if( l->m[3].rtyp != INTVEC_CMD )
4149  {
4151  }
4152  else if( l->m[4].rtyp != INTVEC_CMD )
4153  {
4155  }
4156  else if( l->m[5].rtyp != INTVEC_CMD )
4157  {
4159  }
4160 
4161  // -------------------------
4162  // check number of entries
4163  // -------------------------
4164 
4165  int mu = (int)(long)(l->m[0].Data( ));
4166  int pg = (int)(long)(l->m[1].Data( ));
4167  int n = (int)(long)(l->m[2].Data( ));
4168 
4169  if( n <= 0 )
4170  {
4171  return semicListNNegative;
4172  }
4173 
4174  intvec *num = (intvec*)l->m[3].Data( );
4175  intvec *den = (intvec*)l->m[4].Data( );
4176  intvec *mul = (intvec*)l->m[5].Data( );
4177 
4178  if( n != num->length( ) )
4179  {
4181  }
4182  else if( n != den->length( ) )
4183  {
4185  }
4186  else if( n != mul->length( ) )
4187  {
4189  }
4190 
4191  // --------
4192  // values
4193  // --------
4194 
4195  if( mu <= 0 )
4196  {
4197  return semicListMuNegative;
4198  }
4199  if( pg < 0 )
4200  {
4201  return semicListPgNegative;
4202  }
4203 
4204  int i;
4205 
4206  for( i=0; i<n; i++ )
4207  {
4208  if( (*num)[i] <= 0 )
4209  {
4210  return semicListNumNegative;
4211  }
4212  if( (*den)[i] <= 0 )
4213  {
4214  return semicListDenNegative;
4215  }
4216  if( (*mul)[i] <= 0 )
4217  {
4218  return semicListMulNegative;
4219  }
4220  }
4221 
4222  // ----------------
4223  // check symmetry
4224  // ----------------
4225 
4226  int j;
4227 
4228  for( i=0, j=n-1; i<=j; i++,j-- )
4229  {
4230  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4231  (*den)[i] != (*den)[j] ||
4232  (*mul)[i] != (*mul)[j] )
4233  {
4234  return semicListNotSymmetric;
4235  }
4236  }
4237 
4238  // ----------------
4239  // check monotony
4240  // ----------------
4241 
4242  for( i=0, j=1; i<n/2; i++,j++ )
4243  {
4244  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4245  {
4246  return semicListNotMonotonous;
4247  }
4248  }
4249 
4250  // ---------------------
4251  // check Milnor number
4252  // ---------------------
4253 
4254  for( mu=0, i=0; i<n; i++ )
4255  {
4256  mu += (*mul)[i];
4257  }
4258 
4259  if( mu != (int)(long)(l->m[0].Data( )) )
4260  {
4261  return semicListMilnorWrong;
4262  }
4263 
4264  // -------------------------
4265  // check geometrical genus
4266  // -------------------------
4267 
4268  for( pg=0, i=0; i<n; i++ )
4269  {
4270  if( (*num)[i]<=(*den)[i] )
4271  {
4272  pg += (*mul)[i];
4273  }
4274  }
4275 
4276  if( pg != (int)(long)(l->m[1].Data( )) )
4277  {
4278  return semicListPGWrong;
4279  }
4280 
4281  return semicOK;
4282 }
sleftv * m
Definition: lists.h:45
void mu(int **points, int sizePoints)
Definition: tok.h:85
CanonicalForm num(const CanonicalForm &f)
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
int length() const
Definition: intvec.h:86
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:16
int j
Definition: myNF.cc:70
int i
Definition: cfEzgcd.cc:123
Definition: tok.h:88
int nr
Definition: lists.h:43
CanonicalForm den(const CanonicalForm &f)
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 4932 of file ipshell.cc.

4933 {
4934  int i,j;
4935  int count= self->roots[0]->getAnzRoots(); // number of roots
4936  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
4937 
4938  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
4939 
4940  if ( self->found_roots )
4941  {
4942  listofroots->Init( count );
4943 
4944  for (i=0; i < count; i++)
4945  {
4946  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
4947  onepoint->Init(elem);
4948  for ( j= 0; j < elem; j++ )
4949  {
4950  if ( !rField_is_long_C(currRing) )
4951  {
4952  onepoint->m[j].rtyp=STRING_CMD;
4953  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
4954  }
4955  else
4956  {
4957  onepoint->m[j].rtyp=NUMBER_CMD;
4958  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
4959  }
4960  onepoint->m[j].next= NULL;
4961  onepoint->m[j].name= NULL;
4962  }
4963  listofroots->m[i].rtyp=LIST_CMD;
4964  listofroots->m[i].data=(void *)onepoint;
4965  listofroots->m[j].next= NULL;
4966  listofroots->m[j].name= NULL;
4967  }
4968 
4969  }
4970  else
4971  {
4972  listofroots->Init( 0 );
4973  }
4974 
4975  return listofroots;
4976 }
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:12
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:494
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#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:452
int rtyp
Definition: subexpr.h:92
Definition: tok.h:96
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:717
rootContainer ** roots
Definition: mpr_numeric.h:167
BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4427 of file ipshell.cc.

4428 {
4429  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4430  return FALSE;
4431 }
#define FALSE
Definition: auxiliary.h:140
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3192
void * data
Definition: subexpr.h:89
void * Data()
Definition: subexpr.cc:1111
BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4433 of file ipshell.cc.

4434 {
4435  if ( !(rField_is_long_R(currRing)) )
4436  {
4437  WerrorS("Ground field not implemented!");
4438  return TRUE;
4439  }
4440 
4441  simplex * LP;
4442  matrix m;
4443 
4444  leftv v= args;
4445  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4446  return TRUE;
4447  else
4448  m= (matrix)(v->CopyD());
4449 
4450  LP = new simplex(MATROWS(m),MATCOLS(m));
4451  LP->mapFromMatrix(m);
4452 
4453  v= v->next;
4454  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4455  return TRUE;
4456  else
4457  LP->m= (int)(long)(v->Data());
4458 
4459  v= v->next;
4460  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4461  return TRUE;
4462  else
4463  LP->n= (int)(long)(v->Data());
4464 
4465  v= v->next;
4466  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4467  return TRUE;
4468  else
4469  LP->m1= (int)(long)(v->Data());
4470 
4471  v= v->next;
4472  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4473  return TRUE;
4474  else
4475  LP->m2= (int)(long)(v->Data());
4476 
4477  v= v->next;
4478  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4479  return TRUE;
4480  else
4481  LP->m3= (int)(long)(v->Data());
4482 
4483 #ifdef mprDEBUG_PROT
4484  Print("m (constraints) %d\n",LP->m);
4485  Print("n (columns) %d\n",LP->n);
4486  Print("m1 (<=) %d\n",LP->m1);
4487  Print("m2 (>=) %d\n",LP->m2);
4488  Print("m3 (==) %d\n",LP->m3);
4489 #endif
4490 
4491  LP->compute();
4492 
4493  lists lres= (lists)omAlloc( sizeof(slists) );
4494  lres->Init( 6 );
4495 
4496  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4497  lres->m[0].data=(void*)LP->mapToMatrix(m);
4498 
4499  lres->m[1].rtyp= INT_CMD; // found a solution?
4500  lres->m[1].data=(void*)(long)LP->icase;
4501 
4502  lres->m[2].rtyp= INTVEC_CMD;
4503  lres->m[2].data=(void*)LP->posvToIV();
4504 
4505  lres->m[3].rtyp= INTVEC_CMD;
4506  lres->m[3].data=(void*)LP->zrovToIV();
4507 
4508  lres->m[4].rtyp= INT_CMD;
4509  lres->m[4].data=(void*)(long)LP->m;
4510 
4511  lres->m[5].rtyp= INT_CMD;
4512  lres->m[5].data=(void*)(long)LP->n;
4513 
4514  res->data= (void*)lres;
4515 
4516  return FALSE;
4517 }
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:85
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:194
#define TRUE
Definition: auxiliary.h:144
intvec * zrovToIV()
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:969
#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:12
intvec * posvToIV()
BOOLEAN mapFromMatrix(matrix m)
ip_smatrix * matrix
int m
Definition: cfEzgcd.cc:119
Definition: tok.h:88
leftv next
Definition: subexpr.h:87
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
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:491
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
#define MATROWS(i)
Definition: matpol.h:27
int icase
Definition: mpr_numeric.h:201
void * CopyD(int t)
Definition: subexpr.cc:676
BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2934 of file ipshell.cc.

2935 {
2936  int i,j;
2937  matrix result;
2938  ideal id=(ideal)a->Data();
2939 
2940  result =mpNew(IDELEMS(id),rVar(currRing));
2941  for (i=1; i<=IDELEMS(id); i++)
2942  {
2943  for (j=1; j<=rVar(currRing); j++)
2944  {
2945  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2946  }
2947  }
2948  res->data=(char *)result;
2949  return FALSE;
2950 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
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:12
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:48
void * Data()
Definition: subexpr.cc:1111
#define pDiff(a, b)
Definition: polys.h:267
return result
Definition: facAbsBiFact.cc:76
#define MATELEM(mat, i, j)
Definition: matpol.h:29
BOOLEAN mpKoszul ( leftv  res,
leftv  c,
leftv  b,
leftv  id 
)

Definition at line 2956 of file ipshell.cc.

2957 {
2958  int n=(int)(long)b->Data();
2959  int d=(int)(long)c->Data();
2960  int k,l,sign,row,col;
2961  matrix result;
2962  ideal temp;
2963  BOOLEAN bo;
2964  poly p;
2965 
2966  if ((d>n) || (d<1) || (n<1))
2967  {
2968  res->data=(char *)mpNew(1,1);
2969  return FALSE;
2970  }
2971  int *choise = (int*)omAlloc(d*sizeof(int));
2972  if (id==NULL)
2973  temp=idMaxIdeal(1);
2974  else
2975  temp=(ideal)id->Data();
2976 
2977  k = binom(n,d);
2978  l = k*d;
2979  l /= n-d+1;
2980  result =mpNew(l,k);
2981  col = 1;
2982  idInitChoise(d,1,n,&bo,choise);
2983  while (!bo)
2984  {
2985  sign = 1;
2986  for (l=1;l<=d;l++)
2987  {
2988  if (choise[l-1]<=IDELEMS(temp))
2989  {
2990  p = pCopy(temp->m[choise[l-1]-1]);
2991  if (sign == -1) p = pNeg(p);
2992  sign *= -1;
2993  row = idGetNumberOfChoise(l-1,d,1,n,choise);
2994  MATELEM(result,row,col) = p;
2995  }
2996  }
2997  col++;
2998  idGetNextChoise(d,n,&bo,choise);
2999  }
3000  if (id==NULL) idDelete(&temp);
3001 
3002  res->data=(char *)result;
3003  return FALSE;
3004 }
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:35
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
#define pNeg(p)
Definition: polys.h:169
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:48
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1111
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
polyrec * poly
Definition: hilb.h:10
int BOOLEAN
Definition: auxiliary.h:131
int binom(int n, int r)
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
int sign(const CanonicalForm &a)
#define pCopy(p)
return a copy of the poly
Definition: polys.h:156
#define MATELEM(mat, i, j)
Definition: matpol.h:29
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 4542 of file ipshell.cc.

4543 {
4544 
4545  poly gls;
4546  gls= (poly)(arg1->Data());
4547  int howclean= (int)(long)arg3->Data();
4548 
4549  if ( !(rField_is_R(currRing) ||
4550  rField_is_Q(currRing) ||
4553  {
4554  WerrorS("Ground field not implemented!");
4555  return TRUE;
4556  }
4557 
4560  {
4561  unsigned long int ii = (unsigned long int)arg2->Data();
4562  setGMPFloatDigits( ii, ii );
4563  }
4564 
4565  if ( gls == NULL || pIsConstant( gls ) )
4566  {
4567  WerrorS("Input polynomial is constant!");
4568  return TRUE;
4569  }
4570 
4571  int ldummy;
4572  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4573  // int deg= pDeg( gls );
4574  // int len= pLength( gls );
4575  int i,vpos=0;
4576  poly piter;
4577  lists elist;
4578  lists rlist;
4579 
4580  elist= (lists)omAlloc( sizeof(slists) );
4581  elist->Init( 0 );
4582 
4583  if ( rVar(currRing) > 1 )
4584  {
4585  piter= gls;
4586  for ( i= 1; i <= rVar(currRing); i++ )
4587  if ( pGetExp( piter, i ) )
4588  {
4589  vpos= i;
4590  break;
4591  }
4592  while ( piter )
4593  {
4594  for ( i= 1; i <= rVar(currRing); i++ )
4595  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4596  {
4597  WerrorS("The input polynomial must be univariate!");
4598  return TRUE;
4599  }
4600  pIter( piter );
4601  }
4602  }
4603 
4604  rootContainer * roots= new rootContainer();
4605  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4606  piter= gls;
4607  for ( i= deg; i >= 0; i-- )
4608  {
4609  //if ( piter ) Print("deg %d, pDeg(piter) %d\n",i,pTotaldegree(piter));
4610  if ( piter && pTotaldegree(piter) == i )
4611  {
4612  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4613  //nPrint( pcoeffs[i] );PrintS(" ");
4614  pIter( piter );
4615  }
4616  else
4617  {
4618  pcoeffs[i]= nInit(0);
4619  }
4620  }
4621 
4622 #ifdef mprDEBUG_PROT
4623  for (i=deg; i >= 0; i--)
4624  {
4625  nPrint( pcoeffs[i] );PrintS(" ");
4626  }
4627  PrintLn();
4628 #endif
4629 
4630  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4631  roots->solver( howclean );
4632 
4633  int elem= roots->getAnzRoots();
4634  char *dummy;
4635  int j;
4636 
4637  rlist= (lists)omAlloc( sizeof(slists) );
4638  rlist->Init( elem );
4639 
4641  {
4642  for ( j= 0; j < elem; j++ )
4643  {
4644  rlist->m[j].rtyp=NUMBER_CMD;
4645  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4646  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4647  }
4648  }
4649  else
4650  {
4651  for ( j= 0; j < elem; j++ )
4652  {
4653  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4654  rlist->m[j].rtyp=STRING_CMD;
4655  rlist->m[j].data=(void *)dummy;
4656  }
4657  }
4658 
4659  elist->Clean();
4660  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4661 
4662  // this is (via fillContainer) the same data as in root
4663  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4664  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4665 
4666  delete roots;
4667 
4668  res->rtyp= LIST_CMD;
4669  res->data= (void*)rlist;
4670 
4671  return FALSE;
4672 }
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:327
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:467
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
#define TRUE
Definition: auxiliary.h:144
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:450
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:12
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:253
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:209
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:313
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:294
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:461
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:494
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#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:491
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:1111
Definition: tok.h:96
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:717
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
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 4519 of file ipshell.cc.

4520 {
4521  ideal gls = (ideal)(arg1->Data());
4522  int imtype= (int)(long)arg2->Data();
4523 
4524  uResultant::resMatType mtype= determineMType( imtype );
4525 
4526  // check input ideal ( = polynomial system )
4527  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4528  {
4529  return TRUE;
4530  }
4531 
4532  uResultant *resMat= new uResultant( gls, mtype, false );
4533  if (resMat!=NULL)
4534  {
4535  res->rtyp = MODUL_CMD;
4536  res->data= (void*)resMat->accessResMat()->getMatrix();
4537  if (!errorreported) delete resMat;
4538  }
4539  return errorreported;
4540 }
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:144
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:1111
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 4775 of file ipshell.cc.

4776 {
4777  leftv v= args;
4778 
4779  ideal gls;
4780  int imtype;
4781  int howclean;
4782 
4783  // get ideal
4784  if ( v->Typ() != IDEAL_CMD )
4785  return TRUE;
4786  else gls= (ideal)(v->Data());
4787  v= v->next;
4788 
4789  // get resultant matrix type to use (0,1)
4790  if ( v->Typ() != INT_CMD )
4791  return TRUE;
4792  else imtype= (int)(long)v->Data();
4793  v= v->next;
4794 
4795  if (imtype==0)
4796  {
4797  ideal test_id=idInit(1,1);
4798  int j;
4799  for(j=IDELEMS(gls)-1;j>=0;j--)
4800  {
4801  if (gls->m[j]!=NULL)
4802  {
4803  test_id->m[0]=gls->m[j];
4804  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4805  if (dummy_w!=NULL)
4806  {
4807  WerrorS("Newton polytope not of expected dimension");
4808  delete dummy_w;
4809  return TRUE;
4810  }
4811  }
4812  }
4813  }
4814 
4815  // get and set precision in digits ( > 0 )
4816  if ( v->Typ() != INT_CMD )
4817  return TRUE;
4818  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4820  {
4821  unsigned long int ii=(unsigned long int)v->Data();
4822  setGMPFloatDigits( ii, ii );
4823  }
4824  v= v->next;
4825 
4826  // get interpolation steps (0,1,2)
4827  if ( v->Typ() != INT_CMD )
4828  return TRUE;
4829  else howclean= (int)(long)v->Data();
4830 
4831  uResultant::resMatType mtype= determineMType( imtype );
4832  int i,count;
4833  lists listofroots= NULL;
4834  number smv= NULL;
4835  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4836 
4837  //emptylist= (lists)omAlloc( sizeof(slists) );
4838  //emptylist->Init( 0 );
4839 
4840  //res->rtyp = LIST_CMD;
4841  //res->data= (void *)emptylist;
4842 
4843  // check input ideal ( = polynomial system )
4844  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4845  {
4846  return TRUE;
4847  }
4848 
4849  uResultant * ures;
4850  rootContainer ** iproots;
4851  rootContainer ** muiproots;
4852  rootArranger * arranger;
4853 
4854  // main task 1: setup of resultant matrix
4855  ures= new uResultant( gls, mtype );
4856  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4857  {
4858  WerrorS("Error occurred during matrix setup!");
4859  return TRUE;
4860  }
4861 
4862  // if dense resultant, check if minor nonsingular
4863  if ( mtype == uResultant::denseResMat )
4864  {
4865  smv= ures->accessResMat()->getSubDet();
4866 #ifdef mprDEBUG_PROT
4867  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4868 #endif
4869  if ( nIsZero(smv) )
4870  {
4871  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4872  return TRUE;
4873  }
4874  }
4875 
4876  // main task 2: Interpolate specialized resultant polynomials
4877  if ( interpolate_det )
4878  iproots= ures->interpolateDenseSP( false, smv );
4879  else
4880  iproots= ures->specializeInU( false, smv );
4881 
4882  // main task 3: Interpolate specialized resultant polynomials
4883  if ( interpolate_det )
4884  muiproots= ures->interpolateDenseSP( true, smv );
4885  else
4886  muiproots= ures->specializeInU( true, smv );
4887 
4888 #ifdef mprDEBUG_PROT
4889  int c= iproots[0]->getAnzElems();
4890  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4891  c= muiproots[0]->getAnzElems();
4892  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4893 #endif
4894 
4895  // main task 4: Compute roots of specialized polys and match them up
4896  arranger= new rootArranger( iproots, muiproots, howclean );
4897  arranger->solve_all();
4898 
4899  // get list of roots
4900  if ( arranger->success() )
4901  {
4902  arranger->arrange();
4903  listofroots= listOfRoots(arranger, gmp_output_digits );
4904  }
4905  else
4906  {
4907  WerrorS("Solver was unable to find any roots!");
4908  return TRUE;
4909  }
4910 
4911  // free everything
4912  count= iproots[0]->getAnzElems();
4913  for (i=0; i < count; i++) delete iproots[i];
4914  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4915  count= muiproots[0]->getAnzElems();
4916  for (i=0; i < count; i++) delete muiproots[i];
4917  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4918 
4919  delete ures;
4920  delete arranger;
4921  nDelete( &smv );
4922 
4923  res->data= (void *)listofroots;
4924 
4925  //emptylist->Clean();
4926  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4927 
4928  return FALSE;
4929 }
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:327
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
Definition: tok.h:85
Definition: lists.h:22
virtual IStateType initState() const
Definition: mpr_base.h:41
#define FALSE
Definition: auxiliary.h:140
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:467
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:144
uResultant::resMatType determineMType(int imtype)
void * ADDRESS
Definition: auxiliary.h:161
void pWrite(poly p)
Definition: polys.h:279
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:3060
int Typ()
Definition: subexpr.cc:969
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:12
Definition: intvec.h:16
int j
Definition: myNF.cc:70
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:896
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:294
void solve_all()
Definition: mpr_numeric.cc:871
#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:2922
#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:494
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:491
void * Data()
Definition: subexpr.cc:1111
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
int BOOLEAN
Definition: auxiliary.h:131
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:4932
virtual number getSubDet()
Definition: mpr_base.h:37
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 4674 of file ipshell.cc.

4675 {
4676  int i;
4677  ideal p,w;
4678  p= (ideal)arg1->Data();
4679  w= (ideal)arg2->Data();
4680 
4681  // w[0] = f(p^0)
4682  // w[1] = f(p^1)
4683  // ...
4684  // p can be a vector of numbers (multivariate polynom)
4685  // or one number (univariate polynom)
4686  // tdg = deg(f)
4687 
4688  int n= IDELEMS( p );
4689  int m= IDELEMS( w );
4690  int tdg= (int)(long)arg3->Data();
4691 
4692  res->data= (void*)NULL;
4693 
4694  // check the input
4695  if ( tdg < 1 )
4696  {
4697  WerrorS("Last input parameter must be > 0!");
4698  return TRUE;
4699  }
4700  if ( n != rVar(currRing) )
4701  {
4702  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4703  return TRUE;
4704  }
4705  if ( m != (int)pow((double)tdg+1,(double)n) )
4706  {
4707  Werror("Size of second input ideal must be equal to %d!",
4708  (int)pow((double)tdg+1,(double)n));
4709  return TRUE;
4710  }
4711  if ( !(rField_is_Q(currRing) /* ||
4712  rField_is_R() || rField_is_long_R() ||
4713  rField_is_long_C()*/ ) )
4714  {
4715  WerrorS("Ground field not implemented!");
4716  return TRUE;
4717  }
4718 
4719  number tmp;
4720  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4721  for ( i= 0; i < n; i++ )
4722  {
4723  pevpoint[i]=nInit(0);
4724  if ( (p->m)[i] )
4725  {
4726  tmp = pGetCoeff( (p->m)[i] );
4727  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4728  {
4729  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4730  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4731  return TRUE;
4732  }
4733  } else tmp= NULL;
4734  if ( !nIsZero(tmp) )
4735  {
4736  if ( !pIsConstant((p->m)[i]))
4737  {
4738  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4739  WerrorS("Elements of first input ideal must be numbers!");
4740  return TRUE;
4741  }
4742  pevpoint[i]= nCopy( tmp );
4743  }
4744  }
4745 
4746  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4747  for ( i= 0; i < m; i++ )
4748  {
4749  wresults[i]= nInit(0);
4750  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4751  {
4752  if ( !pIsConstant((w->m)[i]))
4753  {
4754  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4755  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4756  WerrorS("Elements of second input ideal must be numbers!");
4757  return TRUE;
4758  }
4759  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4760  }
4761  }
4762 
4763  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4764  number *ncpoly= vm.interpolateDense( wresults );
4765  // do not free ncpoly[]!!
4766  poly rpoly= vm.numvec2poly( ncpoly );
4767 
4768  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4769  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4770 
4771  res->data= (void*)rpoly;
4772  return FALSE;
4773 }
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:28
#define FALSE
Definition: auxiliary.h:140
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:540
#define TRUE
Definition: auxiliary.h:144
#define nIsOne(n)
Definition: numbers.h:25
void * ADDRESS
Definition: auxiliary.h:161
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:12
int m
Definition: cfEzgcd.cc:119
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:209
int i
Definition: cfEzgcd.cc:123
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:461
#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:1111
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:199
void paPrint ( const char *  n,
package  p 
)

Definition at line 6203 of file ipshell.cc.

6204 {
6205  Print(" %s (",n);
6206  switch (p->language)
6207  {
6208  case LANG_SINGULAR: PrintS("S"); break;
6209  case LANG_C: PrintS("C"); break;
6210  case LANG_TOP: PrintS("T"); break;
6211  case LANG_NONE: PrintS("N"); break;
6212  default: PrintS("U");
6213  }
6214  if(p->libname!=NULL)
6215  Print(",%s", p->libname);
6216  PrintS(")");
6217 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
Definition: subexpr.h:20
void PrintS(const char *s)
Definition: reporter.cc:294
#define NULL
Definition: omList.c:10
ring rCompose ( const lists  L,
const BOOLEAN  check_comp 
)

Definition at line 2409 of file ipshell.cc.

2410 {
2411  if ((L->nr!=3)
2412 #ifdef HAVE_PLURAL
2413  &&(L->nr!=5)
2414 #endif
2415  )
2416  return NULL;
2417  int is_gf_char=0;
2418  // 0: char/ cf - ring
2419  // 1: list (var)
2420  // 2: list (ord)
2421  // 3: qideal
2422  // possibly:
2423  // 4: C
2424  // 5: D
2425 
2426  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2427 
2428 
2429  // ------------------------------------------------------------------
2430  // 0: char:
2431 #ifdef SINGULAR_4_1
2432  if (L->m[0].Typ()==CRING_CMD)
2433  {
2434  R->cf=(coeffs)L->m[0].Data();
2435  R->cf->ref++;
2436  }
2437  else
2438 #endif
2439  if (L->m[0].Typ()==INT_CMD)
2440  {
2441  int ch = (int)(long)L->m[0].Data();
2442  assume( ch >= 0 );
2443 
2444  if (ch == 0) // Q?
2445  R->cf = nInitChar(n_Q, NULL);
2446  else
2447  {
2448  int l = IsPrime(ch); // Zp?
2449  if( l != ch )
2450  {
2451  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2452  ch = l;
2453  }
2454  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2455  }
2456  }
2457  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2458  {
2459  lists LL=(lists)L->m[0].Data();
2460 
2461 #ifdef HAVE_RINGS
2462  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2463  {
2464  rComposeRing(LL, R); // Ring!?
2465  }
2466  else
2467 #endif
2468  if (LL->nr < 3)
2469  rComposeC(LL,R); // R, long_R, long_C
2470  else
2471  {
2472  if (LL->m[0].Typ()==INT_CMD)
2473  {
2474  int ch = (int)(long)LL->m[0].Data();
2475  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2476  if (fftable[is_gf_char]==0) is_gf_char=-1;
2477 
2478  if(is_gf_char!= -1)
2479  {
2480  GFInfo param;
2481 
2482  param.GFChar = ch;
2483  param.GFDegree = 1;
2484  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2485 
2486  // nfInitChar should be able to handle the case when ch is in fftables!
2487  R->cf = nInitChar(n_GF, (void*)&param);
2488  }
2489  }
2490 
2491  if( R->cf == NULL )
2492  {
2493  ring extRing = rCompose((lists)L->m[0].Data(),FALSE);
2494 
2495  if (extRing==NULL)
2496  {
2497  WerrorS("could not create the specified coefficient field");
2498  goto rCompose_err;
2499  }
2500 
2501  if( extRing->qideal != NULL ) // Algebraic extension
2502  {
2503  AlgExtInfo extParam;
2504 
2505  extParam.r = extRing;
2506 
2507  R->cf = nInitChar(n_algExt, (void*)&extParam);
2508  }
2509  else // Transcendental extension
2510  {
2511  TransExtInfo extParam;
2512  extParam.r = extRing;
2513  assume( extRing->qideal == NULL );
2514 
2515  R->cf = nInitChar(n_transExt, &extParam);
2516  }
2517  }
2518  }
2519  }
2520  #ifdef SINGULAR_4_1
2521  else if (L->m[0].Typ()==CRING_CMD)
2522  {
2523  R->cf=(coeffs)L->m[0].Data();
2524  R->cf->ref++;
2525  }
2526  #endif
2527  else
2528  {
2529  WerrorS("coefficient field must be described by `int` or `list`");
2530  goto rCompose_err;
2531  }
2532 
2533  if( R->cf == NULL )
2534  {
2535  WerrorS("could not create coefficient field described by the input!");
2536  goto rCompose_err;
2537  }
2538 
2539  // ------------------------- VARS ---------------------------
2540  if (L->m[1].Typ()==LIST_CMD)
2541  {
2542  lists v=(lists)L->m[1].Data();
2543  R->N = v->nr+1;
2544  if (R->N<=0)
2545  {
2546  WerrorS("no ring variables");
2547  goto rCompose_err;
2548  }
2549  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2550  int i;
2551  for(i=0;i<R->N;i++)
2552  {
2553  if (v->m[i].Typ()==STRING_CMD)
2554  R->names[i]=omStrDup((char *)v->m[i].Data());
2555  else if (v->m[i].Typ()==POLY_CMD)
2556  {
2557  poly p=(poly)v->m[i].Data();
2558  int nr=pIsPurePower(p);
2559  if (nr>0)
2560  R->names[i]=omStrDup(currRing->names[nr-1]);
2561  else
2562  {
2563  Werror("var name %d must be a string or a ring variable",i+1);
2564  goto rCompose_err;
2565  }
2566  }
2567  else
2568  {
2569  Werror("var name %d must be `string`",i+1);
2570  goto rCompose_err;
2571  }
2572  }
2573  }
2574  else
2575  {
2576  WerrorS("variable must be given as `list`");
2577  goto rCompose_err;
2578  }
2579  // ------------------------ ORDER ------------------------------
2580  if (L->m[2].Typ()==LIST_CMD)
2581  {
2582  lists v=(lists)L->m[2].Data();
2583  int n= v->nr+2;
2584  int j;
2585  // initialize fields of R
2586  R->order=(int *)omAlloc0(n*sizeof(int));
2587  R->block0=(int *)omAlloc0(n*sizeof(int));
2588  R->block1=(int *)omAlloc0(n*sizeof(int));
2589  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
2590  // init order, so that rBlocks works correctly
2591  for (j=0; j < n-1; j++)
2592  R->order[j] = (int) ringorder_unspec;
2593  // orderings
2594  for(j=0;j<n-1;j++)
2595  {
2596  // todo: a(..), M
2597  if (v->m[j].Typ()!=LIST_CMD)
2598  {
2599  WerrorS("ordering must be list of lists");
2600  goto rCompose_err;
2601  }
2602  lists vv=(lists)v->m[j].Data();
2603  if ((vv->nr!=1)
2604  || (vv->m[0].Typ()!=STRING_CMD)
2605  || ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD)))
2606  {
2607  WerrorS("ordering name must be a (string,intvec)");
2608  goto rCompose_err;
2609  }
2610  R->order[j]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2611 
2612  if (j==0) R->block0[0]=1;
2613  else
2614  {
2615  int jj=j-1;
2616  while((jj>=0)
2617  && ((R->order[jj]== ringorder_a)
2618  || (R->order[jj]== ringorder_aa)
2619  || (R->order[jj]== ringorder_am)
2620  || (R->order[jj]== ringorder_c)
2621  || (R->order[jj]== ringorder_C)
2622  || (R->order[jj]== ringorder_s)
2623  || (R->order[jj]== ringorder_S)
2624  ))
2625  {
2626  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2627  jj--;
2628  }
2629  if (jj<0) R->block0[j]=1;
2630  else R->block0[j]=R->block1[jj]+1;
2631  }
2632  intvec *iv;
2633  if (vv->m[1].Typ()==INT_CMD)
2634  iv=new intvec((int)(long)vv->m[1].Data(),(int)(long)vv->m[1].Data());
2635  else
2636  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC
2637  int iv_len=iv->length();
2638  R->block1[j]=si_max(R->block0[j],R->block0[j]+iv_len-1);
2639  if (R->block1[j]>R->N)
2640  {
2641  R->block1[j]=R->N;
2642  iv_len=R->block1[j]-R->block0[j]+1;
2643  }
2644  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2645  int i;
2646  switch (R->order[j])
2647  {
2648  case ringorder_ws:
2649  case ringorder_Ws:
2650  R->OrdSgn=-1;
2651  case ringorder_aa:
2652  case ringorder_a:
2653  case ringorder_wp:
2654  case ringorder_Wp:
2655  R->wvhdl[j] =( int *)omAlloc(iv_len*sizeof(int));
2656  for (i=0; i<iv_len;i++)
2657  {
2658  R->wvhdl[j][i]=(*iv)[i];
2659  }
2660  break;
2661  case ringorder_am:
2662  R->wvhdl[j] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2663  for (i=0; i<iv_len;i++)
2664  {
2665  R->wvhdl[j][i]=(*iv)[i];
2666  }
2667  R->wvhdl[j][i]=iv->length() - iv_len;
2668  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2669  for (; i<iv->length(); i++)
2670  {
2671  R->wvhdl[j][i+1]=(*iv)[i];
2672  }
2673  break;
2674  case ringorder_M:
2675  R->wvhdl[j] =( int *)omAlloc((iv->length())*sizeof(int));
2676  for (i=0; i<iv->length();i++) R->wvhdl[j][i]=(*iv)[i];
2677  R->block1[j]=si_max(R->block0[j],R->block0[j]+(int)sqrt((double)(iv->length()-1)));
2678  if (R->block1[j]>R->N)
2679  {
2680  WerrorS("ordering matrix too big");
2681  goto rCompose_err;
2682  }
2683  break;
2684  case ringorder_ls:
2685  case ringorder_ds:
2686  case ringorder_Ds:
2687  case ringorder_rs:
2688  R->OrdSgn=-1;
2689  case ringorder_lp:
2690  case ringorder_dp:
2691  case ringorder_Dp:
2692  case ringorder_rp:
2693  break;
2694  case ringorder_S:
2695  break;
2696  case ringorder_c:
2697  case ringorder_C:
2698  R->block1[j]=R->block0[j]=0;
2699  break;
2700 
2701  case ringorder_s:
2702  break;
2703 
2704  case ringorder_IS:
2705  {
2706  R->block1[j] = R->block0[j] = 0;
2707  if( iv->length() > 0 )
2708  {
2709  const int s = (*iv)[0];
2710  assume( -2 < s && s < 2 );
2711  R->block1[j] = R->block0[j] = s;
2712  }
2713  break;
2714  }
2715  case 0:
2716  case ringorder_unspec:
2717  break;
2718  }
2719  delete iv;
2720  }
2721  // sanity check
2722  j=n-2;
2723  if ((R->order[j]==ringorder_c)
2724  || (R->order[j]==ringorder_C)
2725  || (R->order[j]==ringorder_unspec)) j--;
2726  if (R->block1[j] != R->N)
2727  {
2728  if (((R->order[j]==ringorder_dp) ||
2729  (R->order[j]==ringorder_ds) ||
2730  (R->order[j]==ringorder_Dp) ||
2731  (R->order[j]==ringorder_Ds) ||
2732  (R->order[j]==ringorder_rp) ||
2733  (R->order[j]==ringorder_rs) ||
2734  (R->order[j]==ringorder_lp) ||
2735  (R->order[j]==ringorder_ls))
2736  &&
2737  R->block0[j] <= R->N)
2738  {
2739  R->block1[j] = R->N;
2740  }
2741  else
2742  {
2743  Werror("ordering incomplete: size (%d) should be %d",R->block1[j],R->N);
2744  goto rCompose_err;
2745  }
2746  }
2747  if (R->block0[j]>R->N)
2748  {
2749  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j+1);
2750  for(int ii=0;ii<=j;ii++)
2751  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2752  goto rCompose_err;
2753  }
2754  if (check_comp)
2755  {
2756  BOOLEAN comp_order=FALSE;
2757  int jj;
2758  for(jj=0;jj<n;jj++)
2759  {
2760  if ((R->order[jj]==ringorder_c) ||
2761  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2762  }
2763  if (!comp_order)
2764  {
2765  R->order=(int*)omRealloc0Size(R->order,n*sizeof(int),(n+1)*sizeof(int));
2766  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2767  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2768  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2769  R->order[n-1]=ringorder_C;
2770  R->block0[n-1]=0;
2771  R->block1[n-1]=0;
2772  R->wvhdl[n-1]=NULL;
2773  n++;
2774  }
2775  }
2776  }
2777  else
2778  {
2779  WerrorS("ordering must be given as `list`");
2780  goto rCompose_err;
2781  }
2782 
2783  // ------------------------ ??????? --------------------
2784 
2785  rRenameVars(R);
2786  rComplete(R);
2787 
2788 /*#ifdef HAVE_RINGS
2789 // currently, coefficients which are ring elements require a global ordering:
2790  if (rField_is_Ring(R) && (R->OrdSgn==-1))
2791  {
2792  WerrorS("global ordering required for these coefficients");
2793  goto rCompose_err;
2794  }
2795 #endif*/
2796 
2797 
2798  // ------------------------ Q-IDEAL ------------------------
2799 
2800  if (L->m[3].Typ()==IDEAL_CMD)
2801  {
2802  ideal q=(ideal)L->m[3].Data();
2803  if (q->m[0]!=NULL)
2804  {
2805  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2806  {
2807  #if 0
2808  WerrorS("coefficient fields must be equal if q-ideal !=0");
2809  goto rCompose_err;
2810  #else
2811  ring orig_ring=currRing;
2812  rChangeCurrRing(R);
2813  int *perm=NULL;
2814  int *par_perm=NULL;
2815  int par_perm_size=0;
2816  nMapFunc nMap;
2817 
2818  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2819  {
2820  if (rEqual(orig_ring,currRing))
2821  {
2822  nMap=n_SetMap(currRing->cf, currRing->cf);
2823  }
2824  else
2825  // Allow imap/fetch to be make an exception only for:
2826  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2829  ||
2830  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2831  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2832  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2833  {
2834  par_perm_size=rPar(orig_ring);
2835 
2836 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2837 // naSetChar(rInternalChar(orig_ring),orig_ring);
2838 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2839 
2840  nSetChar(currRing->cf);
2841  }
2842  else
2843  {
2844  WerrorS("coefficient fields must be equal if q-ideal !=0");
2845  goto rCompose_err;
2846  }
2847  }
2848  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2849  if (par_perm_size!=0)
2850  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2851  int i;
2852  #if 0
2853  // use imap:
2854  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2855  currRing->names,currRing->N,currRing->parameter, currRing->P,
2856  perm,par_perm, currRing->ch);
2857  #else
2858  // use fetch
2859  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2860  {
2861  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2862  }
2863  else if (par_perm_size!=0)
2864  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2865  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2866  #endif
2867  ideal dest_id=idInit(IDELEMS(q),1);
2868  for(i=IDELEMS(q)-1; i>=0; i--)
2869  {
2870  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2871  par_perm,par_perm_size);
2872  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2873  pTest(dest_id->m[i]);
2874  }
2875  R->qideal=dest_id;
2876  if (perm!=NULL)
2877  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2878  if (par_perm!=NULL)
2879  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2880  rChangeCurrRing(orig_ring);
2881  #endif
2882  }
2883  else
2884  R->qideal=idrCopyR(q,currRing,R);
2885  }
2886  }
2887  else
2888  {
2889  WerrorS("q-ideal must be given as `ideal`");
2890  goto rCompose_err;
2891  }
2892 
2893 
2894  // ---------------------------------------------------------------
2895  #ifdef HAVE_PLURAL
2896  if (L->nr==5)
2897  {
2898  if (nc_CallPlural((matrix)L->m[4].Data(),
2899  (matrix)L->m[5].Data(),
2900  NULL,NULL,
2901  R,
2902  true, // !!!
2903  true, false,
2904  currRing, FALSE)) goto rCompose_err;
2905  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
2906  }
2907  #endif
2908  return R;
2909 
2910 rCompose_err:
2911  if (R->N>0)
2912  {
2913  int i;
2914  if (R->names!=NULL)
2915  {
2916  i=R->N-1;
2917  while (i>=0) { if (R->names[i]!=NULL) omFree(R->names[i]); i--; }
2918  omFree(R->names);
2919  }
2920  }
2921  if (R->order!=NULL) omFree(R->order);
2922  if (R->block0!=NULL) omFree(R->block0);
2923  if (R->block1!=NULL) omFree(R->block1);
2924  if (R->wvhdl!=NULL) omFree(R->wvhdl);
2925  omFree(R);
2926  return NULL;
2927 }
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:693
#define omRealloc0Size(addr, o_size, size)
Definition: omAllocDecl.h:221
#define pIsPurePower(p)
Definition: polys.h:219
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
ring r
Definition: algext.h:40
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:478
Definition: lists.h:22
ring rCompose(const lists L, const BOOLEAN check_comp)
Definition: ipshell.cc:2409
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
opposite of ls
Definition: ring.h:694
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:547
unsigned short fftable[]
Definition: ffields.cc:61
#define pTest(p)
Definition: polys.h:387
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:437
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:95
#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:540
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:488
#define TRUE
Definition: auxiliary.h:144
int length() const
Definition: intvec.h:86
void * ADDRESS
Definition: auxiliary.h:161
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:969
#define omAlloc(size)
Definition: omAllocDecl.h:210
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2216
Creation data needed for finite fields.
Definition: coeffs.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
char * char_ptr
Definition: structs.h:56
Definition: tok.h:56
Definition: intvec.h:16
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:3436
int j
Definition: myNF.cc:70
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:405
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:94
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:72
const ring R
Definition: DebugPrint.cc:36
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
ip_smatrix * matrix
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:329
int rOrderName(char *ordername)
Definition: ring.cc:508
omBin sip_sring_bin
Definition: ring.cc:54
struct for passing initialization parameters to naInitChar
Definition: transext.h:92
static int si_max(const int a, const int b)
Definition: auxiliary.h:166
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:695
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:461
int IsPrime(int p)
Definition: prime.cc:61
S?
Definition: ring.h:677
Definition: tok.h:88
#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:1633
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:720
static void rRenameVars(ring R)
Definition: ipshell.cc:2368
void rChangeCurrRing(ring r)
Definition: polys.cc:14
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:455
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:93
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar)
Definition: p_polys.cc:3926
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:2747
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
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:2275
#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:35
void * Data()
Definition: subexpr.cc:1111
#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:637
Definition: tok.h:96
polyrec * poly
Definition: hilb.h:10
int * int_ptr
Definition: structs.h:57
int BOOLEAN
Definition: auxiliary.h:131
s?
Definition: ring.h:678
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#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:327
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rComposeC ( lists  L,
ring  R 
)

Definition at line 2216 of file ipshell.cc.

2218 {
2219  // ----------------------------------------
2220  // 0: char/ cf - ring
2221  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2222  {
2223  Werror("invald coeff. field description, expecting 0");
2224  return;
2225  }
2226 // R->cf->ch=0;
2227  // ----------------------------------------
2228  // 1:
2229  if (L->m[1].rtyp!=LIST_CMD)
2230  Werror("invald coeff. field description, expecting precision list");
2231  lists LL=(lists)L->m[1].data;
2232  int r1=(int)(long)LL->m[0].data;
2233  int r2=(int)(long)LL->m[1].data;
2234  if (L->nr==2) // complex
2235  R->cf = nInitChar(n_long_C, NULL);
2236  else if ((r1<=SHORT_REAL_LENGTH)
2237  && (r2=SHORT_REAL_LENGTH))
2238  R->cf = nInitChar(n_R, NULL);
2239  else
2240  {
2242  p->float_len=r1;
2243  p->float_len2=r2;
2244  R->cf = nInitChar(n_long_R, NULL);
2245  }
2246 
2247  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2248  && (r2=SHORT_REAL_LENGTH))
2249  {
2250  R->cf->float_len=SHORT_REAL_LENGTH/2;
2251  R->cf->float_len2=SHORT_REAL_LENGTH;
2252  }
2253  else
2254  {
2255  R->cf->float_len=si_min(r1,32767);
2256  R->cf->float_len2=si_min(r2,32767);
2257  }
2258  // ----------------------------------------
2259  // 2: list (par)
2260  if (L->nr==2)
2261  {
2262  //R->cf->extRing->N=1;
2263  if (L->m[2].rtyp!=STRING_CMD)
2264  {
2265  Werror("invald coeff. field description, expecting parameter name");
2266  return;
2267  }
2268  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2269  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2270  }
2271  // ----------------------------------------
2272 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
#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:167
return P p
Definition: myNF.cc:203
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:573
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:101
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:100
const ring R
Definition: DebugPrint.cc:36
complex floating point (GMP) numbers
Definition: coeffs.h:41
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:96
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#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:327
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2275 of file ipshell.cc.

2277 {
2278  // ----------------------------------------
2279  // 0: string: integer
2280  // no further entries --> Z
2281  mpz_ptr modBase = NULL;
2282  unsigned int modExponent = 1;
2283 
2284  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
2285  if (L->nr == 0)
2286  {
2287  mpz_init_set_ui(modBase,0);
2288  modExponent = 1;
2289  }
2290  // ----------------------------------------
2291  // 1:
2292  else
2293  {
2294  if (L->m[1].rtyp!=LIST_CMD) Werror("invald data, expecting list of numbers");
2295  lists LL=(lists)L->m[1].data;
2296  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2297  {
2298  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2299  // assume that tmp is integer, not rational
2300  n_MPZ (modBase, tmp, coeffs_BIGINT);
2301  }
2302  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2303  {
2304  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2305  }
2306  else
2307  {
2308  mpz_init_set_ui(modBase,0);
2309  }
2310  if (LL->nr >= 1)
2311  {
2312  modExponent = (unsigned long) LL->m[1].data;
2313  }
2314  else
2315  {
2316  modExponent = 1;
2317  }
2318  }
2319  // ----------------------------------------
2320  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2321  {
2322  Werror("Wrong ground ring specification (module is 1)");
2323  return;
2324  }
2325  if (modExponent < 1)
2326  {
2327  Werror("Wrong ground ring specification (exponent smaller than 1");
2328  return;
2329  }
2330  // module is 0 ---> integers
2331  if (mpz_cmp_ui(modBase, 0) == 0)
2332  {
2333  R->cf=nInitChar(n_Z,NULL);
2334  }
2335  // we have an exponent
2336  else if (modExponent > 1)
2337  {
2338  //R->cf->ch = R->cf->modExponent;
2339  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2340  {
2341  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2342  depending on the size of a long on the respective platform */
2343  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2344  omFreeSize (modBase, sizeof(mpz_t));
2345  }
2346  else
2347  {
2348  //ringtype 3
2349  ZnmInfo info;
2350  info.base= modBase;
2351  info.exp= modExponent;
2352  R->cf=nInitChar(n_Znm,(void*) &info);
2353  }
2354  }
2355  // just a module m > 1
2356  else
2357  {
2358  //ringtype = 2;
2359  //const int ch = mpz_get_ui(modBase);
2360  ZnmInfo info;
2361  info.base= modBase;
2362  info.exp= modExponent;
2363  R->cf=nInitChar(n_Zn,(void*) &info);
2364  }
2365 }
mpz_ptr base
Definition: rmodulon.h:18
sleftv * m
Definition: lists.h:45
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:43
Definition: tok.h:85
Definition: lists.h:22
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:45
if(0 > strat->sl)
Definition: myNF.cc:73
Definition: tok.h:42
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
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:44
const ExtensionInfo & info
< [in] sqrfree poly
const ring R
Definition: DebugPrint.cc:36
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:42
unsigned long exp
Definition: rmodulon.h:18
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:96
void Werror(const char *fmt,...)
Definition: reporter.cc:199
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition: coeffs.h:552
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:327
lists rDecompose ( const ring  r)

Definition at line 1894 of file ipshell.cc.

1895 {
1896  assume( r != NULL );
1897  const coeffs C = r->cf;
1898  assume( C != NULL );
1899 
1900  // sanity check: require currRing==r for rings with polynomial data
1901  if ( (r!=currRing) && (
1902  (nCoeff_is_algExt(C) && (C != currRing->cf))
1903  || (r->qideal != NULL)
1904 #ifdef HAVE_PLURAL
1905  || (rIsPluralRing(r))
1906 #endif
1907  )
1908  )
1909  {
1910  WerrorS("ring with polynomial data must be the base ring or compatible");
1911  return NULL;
1912  }
1913  // 0: char/ cf - ring
1914  // 1: list (var)
1915  // 2: list (ord)
1916  // 3: qideal
1917  // possibly:
1918  // 4: C
1919  // 5: D
1921  if (rIsPluralRing(r))
1922  L->Init(6);
1923  else
1924  L->Init(4);
1925  // ----------------------------------------
1926  // 0: char/ cf - ring
1927  L->m[0].rtyp=CRING_CMD;
1928  L->m[0].data=(char*)r->cf; r->cf->ref++;
1929  // ----------------------------------------
1930  // 1: list (var)
1932  LL->Init(r->N);
1933  int i;
1934  for(i=0; i<r->N; i++)
1935  {
1936  LL->m[i].rtyp=STRING_CMD;
1937  LL->m[i].data=(void *)omStrDup(r->names[i]);
1938  }
1939  L->m[1].rtyp=LIST_CMD;
1940  L->m[1].data=(void *)LL;
1941  // ----------------------------------------
1942  // 2: list (ord)
1944  i=rBlocks(r)-1;
1945  LL->Init(i);
1946  i--;
1947  lists LLL;
1948  for(; i>=0; i--)
1949  {
1950  intvec *iv;
1951  int j;
1952  LL->m[i].rtyp=LIST_CMD;
1954  LLL->Init(2);
1955  LLL->m[0].rtyp=STRING_CMD;
1956  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1957 
1958  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1959  {
1960  assume( r->block0[i] == r->block1[i] );
1961  const int s = r->block0[i];
1962  assume( -2 < s && s < 2);
1963 
1964  iv=new intvec(1);
1965  (*iv)[0] = s;
1966  }
1967  else if (r->block1[i]-r->block0[i] >=0 )
1968  {
1969  int bl=j=r->block1[i]-r->block0[i];
1970  if (r->order[i]==ringorder_M)
1971  {
1972  j=(j+1)*(j+1)-1;
1973  bl=j+1;
1974  }
1975  else if (r->order[i]==ringorder_am)
1976  {
1977  j+=r->wvhdl[i][bl+1];
1978  }
1979  iv=new intvec(j+1);
1980  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1981  {
1982  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1983  }
1984  else switch (r->order[i])
1985  {
1986  case ringorder_dp:
1987  case ringorder_Dp:
1988  case ringorder_ds:
1989  case ringorder_Ds:
1990  case ringorder_lp:
1991  for(;j>=0; j--) (*iv)[j]=1;
1992  break;
1993  default: /* do nothing */;
1994  }
1995  }
1996  else
1997  {
1998  iv=new intvec(1);
1999  }
2000  LLL->m[1].rtyp=INTVEC_CMD;
2001  LLL->m[1].data=(void *)iv;
2002  LL->m[i].data=(void *)LLL;
2003  }
2004  L->m[2].rtyp=LIST_CMD;
2005  L->m[2].data=(void *)LL;
2006  // ----------------------------------------
2007  // 3: qideal
2008  L->m[3].rtyp=IDEAL_CMD;
2009  if (r->qideal==NULL)
2010  L->m[3].data=(void *)idInit(1,1);
2011  else
2012  L->m[3].data=(void *)idCopy(r->qideal);
2013  // ----------------------------------------
2014 #ifdef HAVE_PLURAL // NC! in rDecompose
2015  if (rIsPluralRing(r))
2016  {
2017  L->m[4].rtyp=MATRIX_CMD;
2018  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2019  L->m[5].rtyp=MATRIX_CMD;
2020  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2021  }
2022 #endif
2023  return L;
2024 }
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
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
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:12
static int rBlocks(ring r)
Definition: ring.h:516
Definition: tok.h:56
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:911
Definition: intvec.h:16
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:405
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:695
Definition: tok.h:88
ideal idCopy(ideal A)
Definition: ideals.h:73
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#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:96
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:75
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1821 of file ipshell.cc.

1822 {
1823  assume( C != NULL );
1824 
1825  // sanity check: require currRing==r for rings with polynomial data
1826  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1827  {
1828  WerrorS("ring with polynomial data must be the base ring or compatible");
1829  return TRUE;
1830  }
1831  if (nCoeff_is_numeric(C))
1832  {
1833  rDecomposeC(res,C);
1834  }
1835 #ifdef HAVE_RINGS
1836  else if (nCoeff_is_Ring(C))
1837  {
1838  rDecomposeRing(res,C);
1839  }
1840 #endif
1841  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1842  {
1843  rDecomposeCF(res, C->extRing, currRing);
1844  }
1845  else if(nCoeff_is_GF(C))
1846  {
1848  Lc->Init(4);
1849  // char:
1850  Lc->m[0].rtyp=INT_CMD;
1851  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1852  // var:
1854  Lv->Init(1);
1855  Lv->m[0].rtyp=STRING_CMD;
1856  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1857  Lc->m[1].rtyp=LIST_CMD;
1858  Lc->m[1].data=(void*)Lv;
1859  // ord:
1861  Lo->Init(1);
1863  Loo->Init(2);
1864  Loo->m[0].rtyp=STRING_CMD;
1865  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1866 
1867  intvec *iv=new intvec(1); (*iv)[0]=1;
1868  Loo->m[1].rtyp=INTVEC_CMD;
1869  Loo->m[1].data=(void *)iv;
1870 
1871  Lo->m[0].rtyp=LIST_CMD;
1872  Lo->m[0].data=(void*)Loo;
1873 
1874  Lc->m[2].rtyp=LIST_CMD;
1875  Lc->m[2].data=(void*)Lo;
1876  // q-ideal:
1877  Lc->m[3].rtyp=IDEAL_CMD;
1878  Lc->m[3].data=(void *)idInit(1,1);
1879  // ----------------------
1880  res->rtyp=LIST_CMD;
1881  res->data=(void*)Lc;
1882  }
1883  else
1884  {
1885  res->rtyp=INT_CMD;
1886  res->data=(void *)(long)C->ch;
1887  }
1888  // ----------------------------------------
1889  return FALSE;
1890 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:796
sleftv * m
Definition: lists.h:45
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:830
Definition: tok.h:85
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
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:753
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1599
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:911
Definition: intvec.h:16
void rDecomposeRing(leftv h, const coeffs C)
Definition: ipshell.cc:1761
#define assume(x)
Definition: mod2.h:405
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
Definition: tok.h:88
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:837
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#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:96
omBin slists_bin
Definition: lists.cc:23
static void rDecomposeC(leftv h, const coeffs C)
Definition: ipshell.cc:1688
#define omStrDup(s)
Definition: omAllocDecl.h:263
static void rDecomposeC ( leftv  h,
const coeffs  C 
)
static

Definition at line 1688 of file ipshell.cc.

1690 {
1692  if (nCoeff_is_long_C(C)) L->Init(3);
1693  else L->Init(2);
1694  h->rtyp=LIST_CMD;
1695  h->data=(void *)L;
1696  // 0: char/ cf - ring
1697  // 1: list (var)
1698  // 2: list (ord)
1699  // ----------------------------------------
1700  // 0: char/ cf - ring
1701  L->m[0].rtyp=INT_CMD;
1702  L->m[0].data=(void *)0;
1703  // ----------------------------------------
1704  // 1:
1706  LL->Init(2);
1707  LL->m[0].rtyp=INT_CMD;
1708  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1709  LL->m[1].rtyp=INT_CMD;
1710  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1711  L->m[1].rtyp=LIST_CMD;
1712  L->m[1].data=(void *)LL;
1713  // ----------------------------------------
1714  // 2: list (par)
1715  if (nCoeff_is_long_C(C))
1716  {
1717  L->m[2].rtyp=STRING_CMD;
1718  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1719  }
1720  // ----------------------------------------
1721 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:796
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
#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:895
void * data
Definition: subexpr.h:89
static int si_max(const int a, const int b)
Definition: auxiliary.h:166
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:96
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rDecomposeCF ( leftv  h,
const ring  r,
const ring  R 
)

Definition at line 1599 of file ipshell.cc.

1600 {
1602  L->Init(4);
1603  h->rtyp=LIST_CMD;
1604  h->data=(void *)L;
1605  // 0: char/ cf - ring
1606  // 1: list (var)
1607  // 2: list (ord)
1608  // 3: qideal
1609  // ----------------------------------------
1610  // 0: char/ cf - ring
1611  L->m[0].rtyp=INT_CMD;
1612  L->m[0].data=(void *)(long)r->cf->ch;
1613  // ----------------------------------------
1614  // 1: list (var)
1616  LL->Init(r->N);
1617  int i;
1618  for(i=0; i<r->N; i++)
1619  {
1620  LL->m[i].rtyp=STRING_CMD;
1621  LL->m[i].data=(void *)omStrDup(r->names[i]);
1622  }
1623  L->m[1].rtyp=LIST_CMD;
1624  L->m[1].data=(void *)LL;
1625  // ----------------------------------------
1626  // 2: list (ord)
1628  i=rBlocks(r)-1;
1629  LL->Init(i);
1630  i--;
1631  lists LLL;
1632  for(; i>=0; i--)
1633  {
1634  intvec *iv;
1635  int j;
1636  LL->m[i].rtyp=LIST_CMD;
1638  LLL->Init(2);
1639  LLL->m[0].rtyp=STRING_CMD;
1640  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1641  if (r->block1[i]-r->block0[i] >=0 )
1642  {
1643  j=r->block1[i]-r->block0[i];
1644  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1645  iv=new intvec(j+1);
1646  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1647  {
1648  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1649  }
1650  else switch (r->order[i])
1651  {
1652  case ringorder_dp:
1653  case ringorder_Dp:
1654  case ringorder_ds:
1655  case ringorder_Ds:
1656  case ringorder_lp:
1657  for(;j>=0; j--) (*iv)[j]=1;
1658  break;
1659  default: /* do nothing */;
1660  }
1661  }
1662  else
1663  {
1664  iv=new intvec(1);
1665  }
1666  LLL->m[1].rtyp=INTVEC_CMD;
1667  LLL->m[1].data=(void *)iv;
1668  LL->m[i].data=(void *)LLL;
1669  }
1670  L->m[2].rtyp=LIST_CMD;
1671  L->m[2].data=(void *)LL;
1672  // ----------------------------------------
1673  // 3: qideal
1674  L->m[3].rtyp=IDEAL_CMD;
1675  if (nCoeff_is_transExt(R->cf))
1676  L->m[3].data=(void *)idInit(1,1);
1677  else
1678  {
1679  ideal q=idInit(IDELEMS(r->qideal));
1680  q->m[0]=p_Init(R);
1681  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1682  L->m[3].data=(void *)q;
1683 // I->m[0] = pNSet(R->minpoly);
1684  }
1685  // ----------------------------------------
1686 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
Definition: lists.h:22
void * data
Definition: subexpr.h:89
static int rBlocks(ring r)
Definition: ring.h:516
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
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:919
int i
Definition: cfEzgcd.cc:123
Definition: tok.h:88
#define IDELEMS(i)
Definition: simpleideals.h:24
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#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:96
omBin slists_bin
Definition: lists.cc:23
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1248
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rDecomposeRing ( leftv  h,
const coeffs  C 
)

Definition at line 1761 of file ipshell.cc.

1763 {
1765  if (nCoeff_is_Ring(C)) L->Init(1);
1766  else L->Init(2);
1767  h->rtyp=LIST_CMD;
1768  h->data=(void *)L;
1769  // 0: char/ cf - ring
1770  // 1: list (module)
1771  // ----------------------------------------
1772  // 0: char/ cf - ring
1773  L->m[0].rtyp=STRING_CMD;
1774  L->m[0].data=(void *)omStrDup("integer");
1775  // ----------------------------------------
1776  // 1: modulo
1777  if (nCoeff_is_Ring_Z(C)) return;
1779  LL->Init(2);
1780  LL->m[0].rtyp=BIGINT_CMD;
1781  LL->m[0].data=nlMapGMP((number) C->modBase, C, coeffs_BIGINT);
1782  LL->m[1].rtyp=INT_CMD;
1783  LL->m[1].data=(void *) C->modExponent;
1784  L->m[1].rtyp=LIST_CMD;
1785  L->m[1].data=(void *)LL;
1786 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
Definition: lists.h:22
Definition: tok.h:42
static FORCE_INLINE BOOLEAN nCoeff_is_Ring_Z(const coeffs r)
Definition: coeffs.h:750
coeffs coeffs_BIGINT
Definition: ipid.cc:54
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:753
void * data
Definition: subexpr.h:89
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:96
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:210
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
idhdl rDefault ( const char *  s)

Definition at line 1528 of file ipshell.cc.

1529 {
1530  idhdl tmp=NULL;
1531 
1532  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1533  if (tmp==NULL) return NULL;
1534 
1535 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1537  {
1539  memset(&sLastPrinted,0,sizeof(sleftv));
1540  }
1541 
1542  ring r = IDRING(tmp);
1543 
1544  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1545  r->N = 3;
1546  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1547  /*names*/
1548  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1549  r->names[0] = omStrDup("x");
1550  r->names[1] = omStrDup("y");
1551  r->names[2] = omStrDup("z");
1552  /*weights: entries for 3 blocks: NULL*/
1553  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1554  /*order: dp,C,0*/
1555  r->order = (int *) omAlloc(3 * sizeof(int *));
1556  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1557  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1558  /* ringorder dp for the first block: var 1..3 */
1559  r->order[0] = ringorder_dp;
1560  r->block0[0] = 1;
1561  r->block1[0] = 3;
1562  /* ringorder C for the second block: no vars */
1563  r->order[1] = ringorder_C;
1564  /* the last block: everything is 0 */
1565  r->order[2] = 0;
1566 
1567  /* complete ring intializations */
1568  rComplete(r);
1569  rSetHdl(tmp);
1570  return currRingHdl;
1571 }
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:389
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:3436
idhdl currRingHdl
Definition: ipid.cc:65
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void rSetHdl(idhdl h)
Definition: ipshell.cc:4979
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:327
#define omStrDup(s)
Definition: omAllocDecl.h:263
idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1573 of file ipshell.cc.

1574 {
1576  if (h!=NULL) return h;
1577  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1578  if (h!=NULL) return h;
1580  while(p!=NULL)
1581  {
1582  if ((p->cPack!=basePack)
1583  && (p->cPack!=currPack))
1584  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1585  if (h!=NULL) return h;
1586  p=p->next;
1587  }
1588  idhdl tmp=basePack->idroot;
1589  while (tmp!=NULL)
1590  {
1591  if (IDTYP(tmp)==PACKAGE_CMD)
1592  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1593  if (h!=NULL) return h;
1594  tmp=IDNEXT(tmp);
1595  }
1596  return NULL;
1597 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6087
return P p
Definition: myNF.cc:203
#define IDNEXT(a)
Definition: ipid.h:117
proclevel * procstack
Definition: ipid.cc:58
#define IDROOT
Definition: ipid.h:20
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
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:63
ring rInit ( sleftv pn,
sleftv rv,
sleftv ord 
)

Definition at line 5461 of file ipshell.cc.

5462 {
5463 #ifdef HAVE_RINGS
5464  //unsigned int ringtype = 0;
5465  mpz_ptr modBase = NULL;
5466  unsigned int modExponent = 1;
5467 #endif
5468  int float_len=0;
5469  int float_len2=0;
5470  ring R = NULL;
5471  //BOOLEAN ffChar=FALSE;
5472 
5473  /* ch -------------------------------------------------------*/
5474  // get ch of ground field
5475 
5476  // allocated ring
5477  R = (ring) omAlloc0Bin(sip_sring_bin);
5478 
5479  coeffs cf = NULL;
5480 
5481  assume( pn != NULL );
5482  const int P = pn->listLength();
5483 
5484  #ifdef SINGULAR_4_1
5485  if (pn->Typ()==CRING_CMD)
5486  {
5487  cf=(coeffs)pn->CopyD();
5488  if(P>1) /*parameter*/
5489  {
5490  pn = pn->next;
5491  const int pars = pn->listLength();
5492  assume( pars > 0 );
5493  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5494 
5495  if (rSleftvList2StringArray(pn, names))
5496  {
5497  WerrorS("parameter expected");
5498  goto rInitError;
5499  }
5500 
5501  TransExtInfo extParam;
5502 
5503  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5504  for(int i=pars-1; i>=0;i--)
5505  {
5506  omFree(names[i]);
5507  }
5508  omFree(names);
5509 
5510  cf = nInitChar(n_transExt, &extParam);
5511  }
5512  assume( cf != NULL );
5513  }
5514  else
5515  #endif
5516  if (pn->Typ()==INT_CMD)
5517  {
5518  int ch = (int)(long)pn->Data();
5519 
5520  /* parameter? -------------------------------------------------------*/
5521  pn = pn->next;
5522 
5523  if (pn == NULL) // no params!?
5524  {
5525  if (ch!=0)
5526  {
5527  int ch2=IsPrime(ch);
5528  if ((ch<2)||(ch!=ch2))
5529  {
5530  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5531  ch=32003;
5532  }
5533  cf = nInitChar(n_Zp, (void*)(long)ch);
5534  }
5535  else
5536  cf = nInitChar(n_Q, (void*)(long)ch);
5537  }
5538  else
5539  {
5540  const int pars = pn->listLength();
5541 
5542  assume( pars > 0 );
5543 
5544  // predefined finite field: (p^k, a)
5545  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5546  {
5547  GFInfo param;
5548 
5549  param.GFChar = ch;
5550  param.GFDegree = 1;
5551  param.GFPar_name = pn->name;
5552 
5553  cf = nInitChar(n_GF, &param);
5554  }
5555  else // (0/p, a, b, ..., z)
5556  {
5557  if ((ch!=0) && (ch!=IsPrime(ch)))
5558  {
5559  WerrorS("too many parameters");
5560  goto rInitError;
5561  }
5562 
5563  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5564 
5565  if (rSleftvList2StringArray(pn, names))
5566  {
5567  WerrorS("parameter expected");
5568  goto rInitError;
5569  }
5570 
5571  TransExtInfo extParam;
5572 
5573  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5574  for(int i=pars-1; i>=0;i--)
5575  {
5576  omFree(names[i]);
5577  }
5578  omFree(names);
5579 
5580  cf = nInitChar(n_transExt, &extParam);
5581  }
5582  }
5583 
5584 // if (cf==NULL) goto rInitError;
5585  assume( cf != NULL );
5586  }
5587  else if ((pn->name != NULL)
5588  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5589  {
5590  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5591  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5592  {
5593  float_len=(int)(long)pn->next->Data();
5594  float_len2=float_len;
5595  pn=pn->next;
5596  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5597  {
5598  float_len2=(int)(long)pn->next->Data();
5599  pn=pn->next;
5600  }
5601  }
5602 
5603  if (!complex_flag)
5604  complex_flag= pn->next != NULL;
5605  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5606  cf=nInitChar(n_R, NULL);
5607  else // longR or longC?
5608  {
5609  LongComplexInfo param;
5610 
5611  param.float_len = si_min (float_len, 32767);
5612  param.float_len2 = si_min (float_len2, 32767);
5613 
5614  // set the parameter name
5615  if (complex_flag)
5616  {
5617  if (param.float_len < SHORT_REAL_LENGTH)
5618  {
5621  }
5622  if (pn->next == NULL)
5623  param.par_name=(const char*)"i"; //default to i
5624  else
5625  param.par_name = (const char*)pn->next->name;
5626  }
5627 
5628  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5629  }
5630  assume( cf != NULL );
5631  }
5632 #ifdef HAVE_RINGS
5633  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5634  {
5635  // TODO: change to use coeffs_BIGINT!?
5636  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
5637  mpz_init_set_si(modBase, 0);
5638  if (pn->next!=NULL)
5639  {
5640  if (pn->next->Typ()==INT_CMD)
5641  {
5642  mpz_set_ui(modBase, (int)(long) pn->next->Data());
5643  pn=pn->next;
5644  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5645  {
5646  modExponent = (long) pn->next->Data();
5647  pn=pn->next;
5648  }
5649  while ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5650  {
5651  mpz_mul_ui(modBase, modBase, (int)(long) pn->next->Data());
5652  pn=pn->next;
5653  }
5654  }
5655  else if (pn->next->Typ()==BIGINT_CMD)
5656  {
5657  number p=(number)pn->next->CopyD(); // FIXME: why CopyD() here if nlGMP should not overtake p!?
5658  nlGMP(p,(number)modBase,coeffs_BIGINT); // TODO? // extern void nlGMP(number &i, number n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
5659  n_Delete(&p,coeffs_BIGINT);
5660  }
5661  }
5662  else
5663  cf=nInitChar(n_Z,NULL);
5664 
5665  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
5666  {
5667  Werror("Wrong ground ring specification (module is 1)");
5668  goto rInitError;
5669  }
5670  if (modExponent < 1)
5671  {
5672  Werror("Wrong ground ring specification (exponent smaller than 1");
5673  goto rInitError;
5674  }
5675  // module is 0 ---> integers ringtype = 4;
5676  // we have an exponent
5677  if (modExponent > 1 && cf == NULL)
5678  {
5679  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5680  {
5681  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5682  depending on the size of a long on the respective platform */
5683  //ringtype = 1; // Use Z/2^ch
5684  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5685  mpz_clear(modBase);
5686  omFreeSize (modBase, sizeof (mpz_t));
5687  }
5688  else
5689  {
5690  if (mpz_cmp_ui(modBase,0)==0)
5691  {
5692  WerrorS("modulus must not be 0 or parameter not allowed");
5693  goto rInitError;
5694  }
5695  //ringtype = 3;
5696  ZnmInfo info;
5697  info.base= modBase;
5698  info.exp= modExponent;
5699  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5700  }
5701  }
5702  // just a module m > 1
5703  else if (cf == NULL)
5704  {
5705  if (mpz_cmp_ui(modBase,0)==0)
5706  {
5707  WerrorS("modulus must not be 0 or parameter not allowed");
5708  goto rInitError;
5709  }
5710  //ringtype = 2;
5711  ZnmInfo info;
5712  info.base= modBase;
5713  info.exp= modExponent;
5714  cf=nInitChar(n_Zn,(void*) &info);
5715  }
5716  assume( cf != NULL );
5717  }
5718 #endif
5719  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5720  else if ((pn->Typ()==RING_CMD) && (P == 1))
5721  {
5722  TransExtInfo extParam;
5723  extParam.r = (ring)pn->Data();
5724  cf = nInitChar(n_transExt, &extParam);
5725  }
5726  else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5727  {
5728  AlgExtInfo extParam;
5729  extParam.r = (ring)pn->Data();
5730 
5731  cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5732  }
5733  else
5734  {
5735  Werror("Wrong or unknown ground field specification");
5736 #ifndef SING_NDEBUG
5737  sleftv* p = pn;
5738  while (p != NULL)
5739  {
5740  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5741  PrintLn();
5742  p = p->next;
5743  }
5744 #endif
5745  goto rInitError;
5746  }
5747 // pn=pn->next;
5748 
5749  /*every entry in the new ring is initialized to 0*/
5750 
5751  /* characteristic -----------------------------------------------*/
5752  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5753  * 0 1 : Q(a,...) *names FALSE
5754  * 0 -1 : R NULL FALSE 0
5755  * 0 -1 : R NULL FALSE prec. >6
5756  * 0 -1 : C *names FALSE prec. 0..?
5757  * p p : Fp NULL FALSE
5758  * p -p : Fp(a) *names FALSE
5759  * q q : GF(q=p^n) *names TRUE
5760  */
5761  if (cf==NULL)
5762  {
5763  Werror("Invalid ground field specification");
5764  goto rInitError;
5765 // const int ch=32003;
5766 // cf=nInitChar(n_Zp, (void*)(long)ch);
5767  }
5768 
5769  assume( R != NULL );
5770 
5771  R->cf = cf;
5772 
5773  /* names and number of variables-------------------------------------*/
5774  {
5775  int l=rv->listLength();
5776 
5777  if (l>MAX_SHORT)
5778  {
5779  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5780  goto rInitError;
5781  }
5782  R->N = l; /*rv->listLength();*/
5783  }
5784  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5785  if (rSleftvList2StringArray(rv, R->names))
5786  {
5787  WerrorS("name of ring variable expected");
5788  goto rInitError;
5789  }
5790 
5791  /* check names and parameters for conflicts ------------------------- */
5792  rRenameVars(R); // conflicting variables will be renamed
5793  /* ordering -------------------------------------------------------------*/
5794  if (rSleftvOrdering2Ordering(ord, R))
5795  goto rInitError;
5796 
5797  // Complete the initialization
5798  if (rComplete(R,1))
5799  goto rInitError;
5800 
5801 /*#ifdef HAVE_RINGS
5802 // currently, coefficients which are ring elements require a global ordering:
5803  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5804  {
5805  WerrorS("global ordering required for these coefficients");
5806  goto rInitError;
5807  }
5808 #endif*/
5809 
5810  rTest(R);
5811 
5812  // try to enter the ring into the name list
5813  // need to clean up sleftv here, before this ring can be set to
5814  // new currRing or currRing can be killed beacuse new ring has
5815  // same name
5816  if (pn != NULL) pn->CleanUp();
5817  if (rv != NULL) rv->CleanUp();
5818  if (ord != NULL) ord->CleanUp();
5819  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5820  // goto rInitError;
5821 
5822  //memcpy(IDRING(tmp),R,sizeof(*R));
5823  // set current ring
5824  //omFreeBin(R, ip_sring_bin);
5825  //return tmp;
5826  return R;
5827 
5828  // error case:
5829  rInitError:
5830  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5831  if (pn != NULL) pn->CleanUp();
5832  if (rv != NULL) rv->CleanUp();
5833  if (ord != NULL) ord->CleanUp();
5834  return NULL;
5835 }
mpz_ptr base
Definition: rmodulon.h:18
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void PrintLn()
Definition: reporter.cc:327
#define Print
Definition: emacs.cc:83
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:43
Definition: tok.h:85
ring r
Definition: algext.h:40
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
const short MAX_SHORT
Definition: ipshell.cc:5448
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:45
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5145
Definition: tok.h:42
return P p
Definition: myNF.cc:203
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:95
#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:1410
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int Typ()
Definition: subexpr.cc:969
#define omAlloc(size)
Definition: omAllocDecl.h:210
Creation data needed for finite fields.
Definition: coeffs.h:91
idhdl rDefault(const char *s)
Definition: ipshell.cc:1528
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:101
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:100
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:3436
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:44
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:405
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:94
const ExtensionInfo & info
< [in] sqrfree poly
const ring R
Definition: DebugPrint.cc:36
complex floating point (GMP) numbers
Definition: coeffs.h:41
#define rTest(r)
Definition: ring.h:781
omBin sip_sring_bin
Definition: ring.cc:54
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:42
struct for passing initialization parameters to naInitChar
Definition: transext.h:92
unsigned long exp
Definition: rmodulon.h:18
int i
Definition: cfEzgcd.cc:123
int IsPrime(int p)
Definition: prime.cc:61
static void rRenameVars(ring R)
Definition: ipshell.cc:2368
leftv next
Definition: subexpr.h:87
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:93
CanonicalForm cf
Definition: cfModGcd.cc:4024
#define NULL
Definition: omList.c:10
{p^n < 2^16}
Definition: coeffs.h:33
struct for passing initialization parameters to naInitChar
Definition: algext.h:40
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic ...
Definition: coeffs.h:35
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1111
const char * par_name
parameter name
Definition: coeffs.h:102
Definition: tok.h:126
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:456
kBucketDestroy & P
Definition: myNF.cc:191
BOOLEAN rSleftvList2StringArray(sleftv *sl, char **p)
Definition: ipshell.cc:5417
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
void * CopyD(int t)
Definition: subexpr.cc:676
#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:327
#define Warn
Definition: emacs.cc:80
void rKill ( ring  r)

Definition at line 5999 of file ipshell.cc.

6000 {
6001  if ((r->ref<=0)&&(r->order!=NULL))
6002  {
6003 #ifdef RDEBUG
6004  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6005 #endif
6006  if (r->qideal!=NULL)
6007  {
6008  id_Delete(&r->qideal, r);
6009  r->qideal = NULL;
6010  }
6011  int j;
6012 #ifdef USE_IILOCALRING
6013  for (j=0;j<myynest;j++)
6014  {
6015  if (iiLocalRing[j]==r)
6016  {
6017  if (j+1==myynest) Warn("killing the basering for level %d",j);
6018  iiLocalRing[j]=NULL;
6019  }
6020  }
6021 #else /* USE_IILOCALRING */
6022 //#endif /* USE_IILOCALRING */
6023  {
6024  proclevel * nshdl = procstack;
6025  int lev=myynest-1;
6026 
6027  for(; nshdl != NULL; nshdl = nshdl->next)
6028  {
6029  if (nshdl->cRing==r)
6030  {
6031  Warn("killing the basering for level %d",lev);
6032  nshdl->cRing=NULL;
6033  nshdl->cRingHdl=NULL;
6034  }
6035  }
6036  }
6037 #endif /* USE_IILOCALRING */
6038 // any variables depending on r ?
6039  while (r->idroot!=NULL)
6040  {
6041  r->idroot->lev=myynest; // avoid warning about kill global objects
6042  killhdl2(r->idroot,&(r->idroot),r);
6043  }
6044  if (r==currRing)
6045  {
6046  // all dependend stuff is done, clean global vars:
6047  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6049  {
6051  }
6052  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6053  //{
6054  // WerrorS("return value depends on local ring variable (export missing ?)");
6055  // iiRETURNEXPR.CleanUp();
6056  //}
6057  currRing=NULL;
6058  currRingHdl=NULL;
6059  }
6060 
6061  /* nKillChar(r); will be called from inside of rDelete */
6062  rDelete(r);
6063  return;
6064  }
6065  r->ref--;
6066 }
#define TRACE_SHOW_RINGS
Definition: reporter.h:33
#define Print
Definition: emacs.cc:83
proclevel * procstack
Definition: ipid.cc:58
void id_Delete(ideal *h, ring r)
deletes an ideal/module/matrix
int traceit
Definition: febase.cc:47
idhdl cRingHdl
Definition: ipid.h:60
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:12
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:389
int j
Definition: myNF.cc:70
Definition: ipid.h:56
idhdl currRingHdl
Definition: ipid.cc:65
proclevel * next
Definition: ipid.h:59
ring * iiLocalRing
Definition: iplib.cc:525
#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:157
ring cRing
Definition: ipid.h:61
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define Warn
Definition: emacs.cc:80
void rKill ( idhdl  h)

Definition at line 6068 of file ipshell.cc.

6069 {
6070  ring r = IDRING(h);
6071  int ref=0;
6072  if (r!=NULL)
6073  {
6074  ref=r->ref;
6075  rKill(r);
6076  }
6077  if (h==currRingHdl)
6078  {
6079  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6080  else
6081  {
6083  }
6084  }
6085 }
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
const ring r
Definition: syzextra.cc:208
void rKill(ring r)
Definition: ipshell.cc:5999
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1573
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5033 of file ipshell.cc.

5034 {
5035  // change some bad orderings/combination into better ones
5036  leftv h=ord;
5037  while(h!=NULL)
5038  {
5039  BOOLEAN change=FALSE;
5040  intvec *iv = (intvec *)(h->data);
5041  // ws(-i) -> wp(i)
5042  if ((*iv)[1]==ringorder_ws)
5043  {
5044  BOOLEAN neg=TRUE;
5045  for(int i=2;i<iv->length();i++)
5046  if((*iv)[i]>=0) { neg=FALSE; break; }
5047  if (neg)
5048  {
5049  (*iv)[1]=ringorder_wp;
5050  for(int i=2;i<iv->length();i++)
5051  (*iv)[i]= - (*iv)[i];
5052  change=TRUE;
5053  }
5054  }
5055  // Ws(-i) -> Wp(i)
5056  if ((*iv)[1]==ringorder_Ws)
5057  {
5058  BOOLEAN neg=TRUE;
5059  for(int i=2;i<iv->length();i++)
5060  if((*iv)[i]>=0) { neg=FALSE; break; }
5061  if (neg)
5062  {
5063  (*iv)[1]=ringorder_Wp;
5064  for(int i=2;i<iv->length();i++)
5065  (*iv)[i]= -(*iv)[i];
5066  change=TRUE;
5067  }
5068  }
5069  // wp(1) -> dp
5070  if ((*iv)[1]==ringorder_wp)
5071  {
5072  BOOLEAN all_one=TRUE;
5073  for(int i=2;i<iv->length();i++)
5074  if((*iv)[i]!=1) { all_one=FALSE; break; }
5075  if (all_one)
5076  {
5077  intvec *iv2=new intvec(3);
5078  (*iv2)[0]=1;
5079  (*iv2)[1]=ringorder_dp;
5080  (*iv2)[2]=iv->length()-2;
5081  delete iv;
5082  iv=iv2;
5083  h->data=iv2;
5084  change=TRUE;
5085  }
5086  }
5087  // Wp(1) -> Dp
5088  if ((*iv)[1]==ringorder_Wp)
5089  {
5090  BOOLEAN all_one=TRUE;
5091  for(int i=2;i<iv->length();i++)
5092  if((*iv)[i]!=1) { all_one=FALSE; break; }
5093  if (all_one)
5094  {
5095  intvec *iv2=new intvec(3);
5096  (*iv2)[0]=1;
5097  (*iv2)[1]=ringorder_Dp;
5098  (*iv2)[2]=iv->length()-2;
5099  delete iv;
5100  iv=iv2;
5101  h->data=iv2;
5102  change=TRUE;
5103  }
5104  }
5105  // dp(1)/Dp(1)/rp(1) -> lp(1)
5106  if (((*iv)[1]==ringorder_dp)
5107  || ((*iv)[1]==ringorder_Dp)
5108  || ((*iv)[1]==ringorder_rp))
5109  {
5110  if (iv->length()==3)
5111  {
5112  if ((*iv)[2]==1)
5113  {
5114  (*iv)[1]=ringorder_lp;
5115  change=TRUE;
5116  }
5117  }
5118  }
5119  // lp(i),lp(j) -> lp(i+j)
5120  if(((*iv)[1]==ringorder_lp)
5121  && (h->next!=NULL))
5122  {
5123  intvec *iv2 = (intvec *)(h->next->data);
5124  if ((*iv2)[1]==ringorder_lp)
5125  {
5126  leftv hh=h->next;
5127  h->next=hh->next;
5128  hh->next=NULL;
5129  if ((*iv2)[0]==1)
5130  (*iv)[2] += 1; // last block unspecified, at least 1
5131  else
5132  (*iv)[2] += (*iv2)[2];
5133  hh->CleanUp();
5134  omFree(hh);
5135  change=TRUE;
5136  }
5137  }
5138  // -------------------
5139  if (!change) h=h->next;
5140  }
5141  return ord;
5142 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
int length() const
Definition: intvec.h:86
void * data
Definition: subexpr.h:89
Definition: intvec.h:16
#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
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
static void rRenameVars ( ring  R)
static

Definition at line 2368 of file ipshell.cc.

2369 {
2370  int i,j;
2371  BOOLEAN ch;
2372  do
2373  {
2374  ch=0;
2375  for(i=0;i<R->N-1;i++)
2376  {
2377  for(j=i+1;j<R->N;j++)
2378  {
2379  if (strcmp(R->names[i],R->names[j])==0)
2380  {
2381  ch=TRUE;
2382  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2383  omFree(R->names[j]);
2384  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2385  sprintf(R->names[j],"@%s",R->names[i]);
2386  }
2387  }
2388  }
2389  }
2390  while (ch);
2391  for(i=0;i<rPar(R); i++)
2392  {
2393  for(j=0;j<R->N;j++)
2394  {
2395  if (strcmp(rParameter(R)[i],R->names[j])==0)
2396  {
2397  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2398 // omFree(rParameter(R)[i]);
2399 // rParameter(R)[i]=(char *)omAlloc(10);
2400 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2401  omFree(R->names[j]);
2402  R->names[j]=(char *)omAlloc(10);
2403  sprintf(R->names[j],"@@(%d)",i+1);
2404  }
2405  }
2406  }
2407 }
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:547
#define TRUE
Definition: auxiliary.h:144
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:573
#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:131
#define Warn
Definition: emacs.cc:80
void rSetHdl ( idhdl  h)

Definition at line 4979 of file ipshell.cc.

4980 {
4981  ring rg = NULL;
4982  if (h!=NULL)
4983  {
4984 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
4985  rg = IDRING(h);
4986  if (rg==NULL) return; //id <>NULL, ring==NULL
4987  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
4988  if (IDID(h)) // OB: ????
4989  omCheckAddr((ADDRESS)IDID(h));
4990  rTest(rg);
4991  }
4992 
4993  // clean up history
4995  {
4997  memset(&sLastPrinted,0,sizeof(sleftv));
4998  }
4999 
5000  if ((rg!=currRing)&&(currRing!=NULL))
5001  {
5003  if (DENOMINATOR_LIST!=NULL)
5004  {
5005  if (TEST_V_ALLWARN)
5006  Warn("deleting denom_list for ring change to %s",IDID(h));
5007  do
5008  {
5009  n_Delete(&(dd->n),currRing->cf);
5010  dd=dd->next;
5012  DENOMINATOR_LIST=dd;
5013  } while(DENOMINATOR_LIST!=NULL);
5014  }
5015  }
5016 
5017  // test for valid "currRing":
5018  if ((rg!=NULL) && (rg->idroot==NULL))
5019  {
5020  ring old=rg;
5021  rg=rAssure_HasComp(rg);
5022  if (old!=rg)
5023  {
5024  rKill(old);
5025  IDRING(h)=rg;
5026  }
5027  }
5028  /*------------ change the global ring -----------------------*/
5029  rChangeCurrRing(rg);
5030  currRingHdl = h;
5031 }
#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:121
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:81
void * ADDRESS
Definition: auxiliary.h:161
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4559
Definition: idrec.h:34
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
BOOLEAN RingDependend()
Definition: subexpr.cc:389
void rKill(ring r)
Definition: ipshell.cc:5999
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:781
idhdl currRingHdl
Definition: ipid.cc:65
void rChangeCurrRing(ring r)
Definition: polys.cc:14
#define NULL
Definition: omList.c:10
denominator_list next
Definition: kutil.h:67
#define IDRING(a)
Definition: ipid.h:126
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#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:456
static Poly * h
Definition: janet.cc:978
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80
idhdl rSimpleFindHdl ( ring  r,
idhdl  root,
idhdl  n 
)

Definition at line 6087 of file ipshell.cc.

6088 {
6089  //idhdl next_best=NULL;
6090  idhdl h=root;
6091  while (h!=NULL)
6092  {
6093  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
6094  && (h!=n)
6095  && (IDRING(h)==r)
6096  )
6097  {
6098  // if (IDLEV(h)==myynest)
6099  // return h;
6100  // if ((IDLEV(h)==0) || (next_best==NULL))
6101  // next_best=h;
6102  // else if (IDLEV(next_best)<IDLEV(h))
6103  // next_best=h;
6104  return h;
6105  }
6106  h=IDNEXT(h);
6107  }
6108  //return next_best;
6109  return NULL;
6110 }
#define IDNEXT(a)
Definition: ipid.h:117
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:118
const ring r
Definition: syzextra.cc:208
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
BOOLEAN rSleftvList2StringArray ( sleftv sl,
char **  p 
)

Definition at line 5417 of file ipshell.cc.

5418 {
5419 
5420  while(sl!=NULL)
5421  {
5422  if (sl->Name() == sNoName)
5423  {
5424  if (sl->Typ()==POLY_CMD)
5425  {
5426  sleftv s_sl;
5427  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5428  if (s_sl.Name() != sNoName)
5429  *p = omStrDup(s_sl.Name());
5430  else
5431  *p = NULL;
5432  sl->next = s_sl.next;
5433  s_sl.next = NULL;
5434  s_sl.CleanUp();
5435  if (*p == NULL) return TRUE;
5436  }
5437  else
5438  return TRUE;
5439  }
5440  else
5441  *p = omStrDup(sl->Name());
5442  p++;
5443  sl=sl->next;
5444  }
5445  return FALSE;
5446 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define ANY_TYPE
Definition: tok.h:34
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
const char sNoName[]
Definition: subexpr.cc:56
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:969
const char * Name()
Definition: subexpr.h:121
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:358
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5145 of file ipshell.cc.

5146 {
5147  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5148  ord=rOptimizeOrdAsSleftv(ord);
5149  sleftv *sl = ord;
5150 
5151  // determine nBlocks
5152  while (sl!=NULL)
5153  {
5154  intvec *iv = (intvec *)(sl->data);
5155  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5156  i++;
5157  else if ((*iv)[1]==ringorder_L)
5158  {
5159  R->bitmask=(*iv)[2];
5160  n--;
5161  }
5162  else if (((*iv)[1]!=ringorder_a)
5163  && ((*iv)[1]!=ringorder_a64)
5164  && ((*iv)[1]!=ringorder_am))
5165  o++;
5166  n++;
5167  sl=sl->next;
5168  }
5169  // check whether at least one real ordering
5170  if (o==0)
5171  {
5172  WerrorS("invalid combination of orderings");
5173  return TRUE;
5174  }
5175  // if no c/C ordering is given, increment n
5176  if (i==0) n++;
5177  else if (i != 1)
5178  {
5179  // throw error if more than one is given
5180  WerrorS("more than one ordering c/C specified");
5181  return TRUE;
5182  }
5183 
5184  // initialize fields of R
5185  R->order=(int *)omAlloc0(n*sizeof(int));
5186  R->block0=(int *)omAlloc0(n*sizeof(int));
5187  R->block1=(int *)omAlloc0(n*sizeof(int));
5188  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5189 
5190  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5191 
5192  // init order, so that rBlocks works correctly
5193  for (j=0; j < n-1; j++)
5194  R->order[j] = (int) ringorder_unspec;
5195  // set last _C order, if no c/C order was given
5196  if (i == 0) R->order[n-2] = ringorder_C;
5197 
5198  /* init orders */
5199  sl=ord;
5200  n=-1;
5201  while (sl!=NULL)
5202  {
5203  intvec *iv;
5204  iv = (intvec *)(sl->data);
5205  if ((*iv)[1]!=ringorder_L)
5206  {
5207  n++;
5208 
5209  /* the format of an ordering:
5210  * iv[0]: factor
5211  * iv[1]: ordering
5212  * iv[2..end]: weights
5213  */
5214  R->order[n] = (*iv)[1];
5215  typ=1;
5216  switch ((*iv)[1])
5217  {
5218  case ringorder_ws:
5219  case ringorder_Ws:
5220  typ=-1;
5221  case ringorder_wp:
5222  case ringorder_Wp:
5223  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5224  R->block0[n] = last+1;
5225  for (i=2; i<iv->length(); i++)
5226  {
5227  R->wvhdl[n][i-2] = (*iv)[i];
5228  last++;
5229  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5230  }
5231  R->block1[n] = si_min(last,R->N);
5232  break;
5233  case ringorder_ls:
5234  case ringorder_ds:
5235  case ringorder_Ds:
5236  case ringorder_rs:
5237  typ=-1;
5238  case ringorder_lp:
5239  case ringorder_dp:
5240  case ringorder_Dp:
5241  case ringorder_rp:
5242  R->block0[n] = last+1;
5243  if (iv->length() == 3) last+=(*iv)[2];
5244  else last += (*iv)[0];
5245  R->block1[n] = si_min(last,R->N);
5246  if (rCheckIV(iv)) return TRUE;
5247  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5248  {
5249  if (weights[i]==0) weights[i]=typ;
5250  }
5251  break;
5252 
5253  case ringorder_s: // no 'rank' params!
5254  {
5255 
5256  if(iv->length() > 3)
5257  return TRUE;
5258 
5259  if(iv->length() == 3)
5260  {
5261  const int s = (*iv)[2];
5262  R->block0[n] = s;
5263  R->block1[n] = s;
5264  }
5265  break;
5266  }
5267  case ringorder_IS:
5268  {
5269  if(iv->length() != 3) return TRUE;
5270 
5271  const int s = (*iv)[2];
5272 
5273  if( 1 < s || s < -1 ) return TRUE;
5274 
5275  R->block0[n] = s;
5276  R->block1[n] = s;
5277  break;
5278  }
5279  case ringorder_S:
5280  case ringorder_c:
5281  case ringorder_C:
5282  {
5283  if (rCheckIV(iv)) return TRUE;
5284  break;
5285  }
5286  case ringorder_aa:
5287  case ringorder_a:
5288  {
5289  R->block0[n] = last+1;
5290  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5291  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5292  for (i=2; i<iv->length(); i++)
5293  {
5294  R->wvhdl[n][i-2]=(*iv)[i];
5295  last++;
5296  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5297  }
5298  last=R->block0[n]-1;
5299  break;
5300  }
5301  case ringorder_am:
5302  {
5303  R->block0[n] = last+1;
5304  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5305  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5306  if (R->block1[n]- R->block0[n]+2>=iv->length())
5307  WarnS("missing module weights");
5308  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5309  {
5310  R->wvhdl[n][i-2]=(*iv)[i];
5311  last++;
5312  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5313  }
5314  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5315  for (; i<iv->length(); i++)
5316  {
5317  R->wvhdl[n][i-1]=(*iv)[i];
5318  }
5319  last=R->block0[n]-1;
5320  break;
5321  }
5322  case ringorder_a64:
5323  {
5324  R->block0[n] = last+1;
5325  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5326  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5327  int64 *w=(int64 *)R->wvhdl[n];
5328  for (i=2; i<iv->length(); i++)
5329  {
5330  w[i-2]=(*iv)[i];
5331  last++;
5332  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5333  }
5334  last=R->block0[n]-1;
5335  break;
5336  }
5337  case ringorder_M:
5338  {
5339  int Mtyp=rTypeOfMatrixOrder(iv);
5340  if (Mtyp==0) return TRUE;
5341  if (Mtyp==-1) typ = -1;
5342 
5343  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5344  for (i=2; i<iv->length();i++)
5345  R->wvhdl[n][i-2]=(*iv)[i];
5346 
5347  R->block0[n] = last+1;
5348  last += (int)sqrt((double)(iv->length()-2));
5349  R->block1[n] = si_min(last,R->N);
5350  for(i=R->block1[n];i>=R->block0[n];i--)
5351  {
5352  if (weights[i]==0) weights[i]=typ;
5353  }
5354  break;
5355  }
5356 
5357  case ringorder_no:
5358  R->order[n] = ringorder_unspec;
5359  return TRUE;
5360 
5361  default:
5362  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5363  R->order[n] = ringorder_unspec;
5364  return TRUE;
5365  }
5366  }
5367  if (last>R->N)
5368  {
5369  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5370  R->N,last);
5371  return TRUE;
5372  }
5373  sl=sl->next;
5374  }
5375 
5376  // check for complete coverage
5377  while ( n >= 0 && (
5378  (R->order[n]==ringorder_c)
5379  || (R->order[n]==ringorder_C)
5380  || (R->order[n]==ringorder_s)
5381  || (R->order[n]==ringorder_S)
5382  || (R->order[n]==ringorder_IS)
5383  )) n--;
5384 
5385  assume( n >= 0 );
5386 
5387  if (R->block1[n] != R->N)
5388  {
5389  if (((R->order[n]==ringorder_dp) ||
5390  (R->order[n]==ringorder_ds) ||
5391  (R->order[n]==ringorder_Dp) ||
5392  (R->order[n]==ringorder_Ds) ||
5393  (R->order[n]==ringorder_rp) ||
5394  (R->order[n]==ringorder_rs) ||
5395  (R->order[n]==ringorder_lp) ||
5396  (R->order[n]==ringorder_ls))
5397  &&
5398  R->block0[n] <= R->N)
5399  {
5400  R->block1[n] = R->N;
5401  }
5402  else
5403  {
5404  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5405  R->N,R->block1[n]);
5406  return TRUE;
5407  }
5408  }
5409  // find OrdSgn:
5410  R->OrdSgn = 1;
5411  for(i=1;i<=R->N;i++)
5412  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5413  omFree(weights);
5414  return FALSE;
5415 }
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:693
const CanonicalForm int s
Definition: facAbsFact.cc:55
for int64 weights
Definition: ring.h:673
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
#define FALSE
Definition: auxiliary.h:140
opposite of ls
Definition: ring.h:694
static poly last
Definition: hdegree.cc:1075
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
long int64
Definition: auxiliary.h:112
#define TRUE
Definition: auxiliary.h:144
int length() const
Definition: intvec.h:86
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
int rTypeOfMatrixOrder(intvec *order)
Definition: ring.cc:195
Definition: intvec.h:16
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:5033
BOOLEAN rCheckIV(intvec *iv)
Definition: ring.cc:185
#define assume(x)
Definition: mod2.h:405
const ring R
Definition: DebugPrint.cc:36
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:329
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:695
S?
Definition: ring.h:677
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
const CanonicalForm & w
Definition: facAbsFact.cc:55
int * int_ptr
Definition: structs.h:57
s?
Definition: ring.h:678
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 5837 of file ipshell.cc.

5838 {
5839  ring R = rCopy0(org_ring);
5840  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
5841  int n = rBlocks(org_ring), i=0, j;
5842 
5843  /* names and number of variables-------------------------------------*/
5844  {
5845  int l=rv->listLength();
5846  if (l>MAX_SHORT)
5847  {
5848  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5849  goto rInitError;
5850  }
5851  R->N = l; /*rv->listLength();*/
5852  }
5853  omFree(R->names);
5854  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5855  if (rSleftvList2StringArray(rv, R->names))
5856  {
5857  WerrorS("name of ring variable expected");
5858  goto rInitError;
5859  }
5860 
5861  /* check names for subring in org_ring ------------------------- */
5862  {
5863  i=0;
5864 
5865  for(j=0;j<R->N;j++)
5866  {
5867  for(;i<org_ring->N;i++)
5868  {
5869  if (strcmp(org_ring->names[i],R->names[j])==0)
5870  {
5871  perm[i+1]=j+1;
5872  break;
5873  }
5874  }
5875  if (i>org_ring->N)
5876  {
5877  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5878  break;
5879  }
5880  }
5881  }
5882  //Print("perm=");
5883  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
5884  /* ordering -------------------------------------------------------------*/
5885 
5886  for(i=0;i<n;i++)
5887  {
5888  int min_var=-1;
5889  int max_var=-1;
5890  for(j=R->block0[i];j<=R->block1[i];j++)
5891  {
5892  if (perm[j]>0)
5893  {
5894  if (min_var==-1) min_var=perm[j];
5895  max_var=perm[j];
5896  }
5897  }
5898  if (min_var!=-1)
5899  {
5900  //Print("block %d: old %d..%d, now:%d..%d\n",
5901  // i,R->block0[i],R->block1[i],min_var,max_var);
5902  R->block0[i]=min_var;
5903  R->block1[i]=max_var;
5904  if (R->wvhdl[i]!=NULL)
5905  {
5906  omFree(R->wvhdl[i]);
5907  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
5908  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
5909  {
5910  if (perm[j]>0)
5911  {
5912  R->wvhdl[i][perm[j]-R->block0[i]]=
5913  org_ring->wvhdl[i][j-org_ring->block0[i]];
5914  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
5915  }
5916  }
5917  }
5918  }
5919  else
5920  {
5921  if(R->block0[i]>0)
5922  {
5923  //Print("skip block %d\n",i);
5924  R->order[i]=ringorder_unspec;
5925  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
5926  R->wvhdl[i]=NULL;
5927  }
5928  //else Print("keep block %d\n",i);
5929  }
5930  }
5931  i=n-1;
5932  while(i>0)
5933  {
5934  // removed unneded blocks
5935  if(R->order[i-1]==ringorder_unspec)
5936  {
5937  for(j=i;j<=n;j++)
5938  {
5939  R->order[j-1]=R->order[j];
5940  R->block0[j-1]=R->block0[j];
5941  R->block1[j-1]=R->block1[j];
5942  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
5943  R->wvhdl[j-1]=R->wvhdl[j];
5944  }
5945  R->order[n]=ringorder_unspec;
5946  n--;
5947  }
5948  i--;
5949  }
5950  n=rBlocks(org_ring)-1;
5951  while (R->order[n]==0) n--;
5952  while (R->order[n]==ringorder_unspec) n--;
5953  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
5954  if (R->block1[n] != R->N)
5955  {
5956  if (((R->order[n]==ringorder_dp) ||
5957  (R->order[n]==ringorder_ds) ||
5958  (R->order[n]==ringorder_Dp) ||
5959  (R->order[n]==ringorder_Ds) ||
5960  (R->order[n]==ringorder_rp) ||
5961  (R->order[n]==ringorder_rs) ||
5962  (R->order[n]==ringorder_lp) ||
5963  (R->order[n]==ringorder_ls))
5964  &&
5965  R->block0[n] <= R->N)
5966  {
5967  R->block1[n] = R->N;
5968  }
5969  else
5970  {
5971  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
5972  R->N,R->block1[n],n);
5973  return NULL;
5974  }
5975  }
5976  omFree(perm);
5977  // find OrdSgn:
5978  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
5979  //for(i=1;i<=R->N;i++)
5980  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
5981  //omFree(weights);
5982  // Complete the initialization
5983  if (rComplete(R,1))
5984  goto rInitError;
5985 
5986  rTest(R);
5987 
5988  if (rv != NULL) rv->CleanUp();
5989 
5990  return R;
5991 
5992  // error case:
5993  rInitError:
5994  if (R != NULL) rDelete(R);
5995  if (rv != NULL) rv->CleanUp();
5996  return NULL;
5997 }
const short MAX_SHORT
Definition: ipshell.cc:5448
opposite of ls
Definition: ring.h:694
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:516
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:3436
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:1318
const ring R
Definition: DebugPrint.cc:36
#define rTest(r)
Definition: ring.h:781
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:321
BOOLEAN rSleftvList2StringArray(sleftv *sl, char **p)
Definition: ipshell.cc:5417
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
lists scIndIndset ( ideal  S,
BOOLEAN  all,
ideal  Q 
)

Definition at line 1019 of file ipshell.cc.

1020 {
1021  int i;
1022  indset save;
1024 
1025  hexist = hInit(S, Q, &hNexist, currRing);
1026  if (hNexist == 0)
1027  {
1028  intvec *iv=new intvec(rVar(currRing));
1029  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1030  res->Init(1);
1031  res->m[0].rtyp=INTVEC_CMD;
1032  res->m[0].data=(intvec*)iv;
1033  return res;
1034  }
1035  else if (hisModule!=0)
1036  {
1037  res->Init(0);
1038  return res;
1039  }
1040  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1041  hMu = 0;
1042  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1043  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1044  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1045  hrad = hexist;
1046  hNrad = hNexist;
1047  radmem = hCreate(rVar(currRing) - 1);
1048  hCo = rVar(currRing) + 1;
1049  hNvar = rVar(currRing);
1050  hRadical(hrad, &hNrad, hNvar);
1051  hSupp(hrad, hNrad, hvar, &hNvar);
1052  if (hNvar)
1053  {
1054  hCo = hNvar;
1055  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1056  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1057  hLexR(hrad, hNrad, hvar, hNvar);
1059  }
1060  if (hCo && (hCo < rVar(currRing)))
1061  {
1063  }
1064  if (hMu!=0)
1065  {
1066  ISet = save;
1067  hMu2 = 0;
1068  if (all && (hCo+1 < rVar(currRing)))
1069  {
1072  i=hMu+hMu2;
1073  res->Init(i);
1074  if (hMu2 == 0)
1075  {
1077  }
1078  }
1079  else
1080  {
1081  res->Init(hMu);
1082  }
1083  for (i=0;i<hMu;i++)
1084  {
1085  res->m[i].data = (void *)save->set;
1086  res->m[i].rtyp = INTVEC_CMD;
1087  ISet = save;
1088  save = save->nx;
1090  }
1091  omFreeBin((ADDRESS)save, indlist_bin);
1092  if (hMu2 != 0)
1093  {
1094  save = JSet;
1095  for (i=hMu;i<hMu+hMu2;i++)
1096  {
1097  res->m[i].data = (void *)save->set;
1098  res->m[i].rtyp = INTVEC_CMD;
1099  JSet = save;
1100  save = save->nx;
1102  }
1103  omFreeBin((ADDRESS)save, indlist_bin);
1104  }
1105  }
1106  else
1107  {
1108  res->Init(0);
1110  }
1111  hKill(radmem, rVar(currRing) - 1);
1112  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1113  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1114  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1116  return res;
1117 }
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:23
int hCo
Definition: hdegree.cc:22
Definition: lists.h:22
scmon * scfmon
Definition: hutil.h:22
#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:540
monf hCreate(int Nvar)
Definition: hutil.cc:1002
int hNvar
Definition: hutil.cc:22
void * ADDRESS
Definition: auxiliary.h:161
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:12
indset ISet
Definition: hdegree.cc:279
Definition: intvec.h:16
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:35
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:21
int i
Definition: cfEzgcd.cc:123
Definition: tok.h:88
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:571
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#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
BOOLEAN semicProc ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 4415 of file ipshell.cc.

4416 {
4417  sleftv tmp;
4418  memset(&tmp,0,sizeof(tmp));
4419  tmp.rtyp=INT_CMD;
4420  /* tmp.data = (void *)0; -- done by memset */
4421 
4422  return semicProc3(res,u,v,&tmp);
4423 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:85
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4375
int rtyp
Definition: subexpr.h:92
BOOLEAN semicProc3 ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 4375 of file ipshell.cc.

4376 {
4377  semicState state;
4378  BOOLEAN qh=(((int)(long)w->Data())==1);
4379 
4380  // -----------------
4381  // check arguments
4382  // -----------------
4383 
4384  lists l1 = (lists)u->Data( );
4385  lists l2 = (lists)v->Data( );
4386 
4387  if( (state=list_is_spectrum( l1 ))!=semicOK )
4388  {
4389  WerrorS( "first argument is not a spectrum" );
4390  list_error( state );
4391  }
4392  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4393  {
4394  WerrorS( "second argument is not a spectrum" );
4395  list_error( state );
4396  }
4397  else
4398  {
4399  spectrum s1= spectrumFromList( l1 );
4400  spectrum s2= spectrumFromList( l2 );
4401 
4402  res->rtyp = INT_CMD;
4403  if (qh)
4404  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4405  else
4406  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4407  }
4408 
4409  // -----------------
4410  // check status
4411  // -----------------
4412 
4413  return (state!=semicOK);
4414 }
Definition: tok.h:85
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3248
void list_error(semicState state)
Definition: ipshell.cc:3332
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:4117
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3298
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
int BOOLEAN
Definition: auxiliary.h:131
int mult_spectrum(spectrum &)
Definition: semic.cc:396
BOOLEAN spaddProc ( leftv  result,
leftv  first,
leftv  second 
)

Definition at line 4292 of file ipshell.cc.

4293 {
4294  semicState state;
4295 
4296  // -----------------
4297  // check arguments
4298  // -----------------
4299 
4300  lists l1 = (lists)first->Data( );
4301  lists l2 = (lists)second->Data( );
4302 
4303  if( (state=list_is_spectrum( l1 )) != semicOK )
4304  {
4305  WerrorS( "first argument is not a spectrum:" );
4306  list_error( state );
4307  }
4308  else if( (state=list_is_spectrum( l2 )) != semicOK )
4309  {
4310  WerrorS( "second argument is not a spectrum:" );
4311  list_error( state );
4312  }
4313  else
4314  {
4315  spectrum s1= spectrumFromList ( l1 );
4316  spectrum s2= spectrumFromList ( l2 );
4317  spectrum sum( s1+s2 );
4318 
4319  result->rtyp = LIST_CMD;
4320  result->data = (char*)(getList(sum));
4321  }
4322 
4323  return (state!=semicOK);
4324 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3248
void list_error(semicState state)
Definition: ipshell.cc:3332
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3260
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4117
semicState
Definition: ipshell.cc:3298
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:96
spectrumState spectrumCompute ( poly  h,
lists L,
int  fast 
)

Definition at line 3674 of file ipshell.cc.

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

Definition at line 4048 of file ipshell.cc.

4049 {
4050  spectrumState state = spectrumOK;
4051 
4052  // -------------------
4053  // check consistency
4054  // -------------------
4055 
4056  // check for a local polynomial ring
4057 
4058  if( currRing->OrdSgn != -1 )
4059  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4060  // or should we use:
4061  //if( !ringIsLocal( ) )
4062  {
4063  WerrorS( "only works for local orderings" );
4064  state = spectrumWrongRing;
4065  }
4066  else if( currRing->qideal != NULL )
4067  {
4068  WerrorS( "does not work in quotient rings" );
4069  state = spectrumWrongRing;
4070  }
4071  else
4072  {
4073  lists L = (lists)NULL;
4074  int flag = 2; // symmetric optimization
4075 
4076  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4077 
4078  if( state==spectrumOK )
4079  {
4080  result->rtyp = LIST_CMD;
4081  result->data = (char*)L;
4082  }
4083  else
4084  {
4085  spectrumPrintError(state);
4086  }
4087  }
4088 
4089  return (state!=spectrumOK);
4090 }
spectrumState
Definition: ipshell.cc:3414
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:12
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:3966
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3674
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:96
polyrec * poly
Definition: hilb.h:10
spectrum spectrumFromList ( lists  l)

Definition at line 3248 of file ipshell.cc.

3249 {
3250  spectrum result;
3251  copy_deep( result, l );
3252  return result;
3253 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3224
return result
Definition: facAbsBiFact.cc:76
void spectrumPrintError ( spectrumState  state)

Definition at line 3966 of file ipshell.cc.

3967 {
3968  switch( state )
3969  {
3970  case spectrumZero:
3971  WerrorS( "polynomial is zero" );
3972  break;
3973  case spectrumBadPoly:
3974  WerrorS( "polynomial has constant term" );
3975  break;
3976  case spectrumNoSingularity:
3977  WerrorS( "not a singularity" );
3978  break;
3979  case spectrumNotIsolated:
3980  WerrorS( "the singularity is not isolated" );
3981  break;
3982  case spectrumNoHC:
3983  WerrorS( "highest corner cannot be computed" );
3984  break;
3985  case spectrumDegenerate:
3986  WerrorS( "principal part is degenerate" );
3987  break;
3988  case spectrumOK:
3989  break;
3990 
3991  default:
3992  WerrorS( "unknown error occurred" );
3993  break;
3994  }
3995 }
void WerrorS(const char *s)
Definition: feFopen.cc:24
BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 3997 of file ipshell.cc.

3998 {
3999  spectrumState state = spectrumOK;
4000 
4001  // -------------------
4002  // check consistency
4003  // -------------------
4004 
4005  // check for a local ring
4006 
4007  if( !ringIsLocal(currRing ) )
4008  {
4009  WerrorS( "only works for local orderings" );
4010  state = spectrumWrongRing;
4011  }
4012 
4013  // no quotient rings are allowed
4014 
4015  else if( currRing->qideal != NULL )
4016  {
4017  WerrorS( "does not work in quotient rings" );
4018  state = spectrumWrongRing;
4019  }
4020  else
4021  {
4022  lists L = (lists)NULL;
4023  int flag = 1; // weight corner optimization is safe
4024 
4025  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4026 
4027  if( state==spectrumOK )
4028  {
4029  result->rtyp = LIST_CMD;
4030  result->data = (char*)L;
4031  }
4032  else
4033  {
4034  spectrumPrintError(state);
4035  }
4036  }
4037 
4038  return (state!=spectrumOK);
4039 }
spectrumState
Definition: ipshell.cc:3414
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:12
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:3966
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3674
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:96
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
polyrec * poly
Definition: hilb.h:10
spectrumState spectrumStateFromList ( spectrumPolyList speclist,
lists L,
int  fast 
)

Definition at line 3433 of file ipshell.cc.

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

Definition at line 4334 of file ipshell.cc.

4335 {
4336  semicState state;
4337 
4338  // -----------------
4339  // check arguments
4340  // -----------------
4341 
4342  lists l = (lists)first->Data( );
4343  int k = (int)(long)second->Data( );
4344 
4345  if( (state=list_is_spectrum( l ))!=semicOK )
4346  {
4347  WerrorS( "first argument is not a spectrum" );
4348  list_error( state );
4349  }
4350  else if( k < 0 )
4351  {
4352  WerrorS( "second argument should be positive" );
4353  state = semicMulNegative;
4354  }
4355  else
4356  {
4357  spectrum s= spectrumFromList( l );
4358  spectrum product( k*s );
4359 
4360  result->rtyp = LIST_CMD;
4361  result->data = (char*)getList(product);
4362  }
4363 
4364  return (state!=semicOK);
4365 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3248
void list_error(semicState state)
Definition: ipshell.cc:3332
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:3260
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4117
semicState
Definition: ipshell.cc:3298
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:96
int l
Definition: cfEzgcd.cc:94
BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3034 of file ipshell.cc.

3035 {
3036  sleftv tmp;
3037  memset(&tmp,0,sizeof(tmp));
3038  tmp.rtyp=INT_CMD;
3039  tmp.data=(void *)1;
3040  return syBetti2(res,u,&tmp);
3041 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:85
void * data
Definition: subexpr.h:89
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3011
int rtyp
Definition: subexpr.h:92
BOOLEAN syBetti2 ( leftv  res,
leftv  u,
leftv  w 
)

Definition at line 3011 of file ipshell.cc.

3012 {
3013  syStrategy syzstr=(syStrategy)u->Data();
3014 
3015  BOOLEAN minim=(int)(long)w->Data();
3016  int row_shift=0;
3017  int add_row_shift=0;
3018  intvec *weights=NULL;
3019  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3020  if (ww!=NULL)
3021  {
3022  weights=ivCopy(ww);
3023  add_row_shift = ww->min_in();
3024  (*weights) -= add_row_shift;
3025  }
3026 
3027  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3028  //row_shift += add_row_shift;
3029  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3030  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3031 
3032  return FALSE;
3033 }
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:85
#define FALSE
Definition: auxiliary.h:140
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
int min_in()
Definition: intvec.h:114
void * data
Definition: subexpr.h:89
Definition: intvec.h:16
Definition: tok.h:88
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:1767
void * Data()
Definition: subexpr.cc:1111
int BOOLEAN
Definition: auxiliary.h:131
ssyStrategy * syStrategy
Definition: syz.h:35
#define omStrDup(s)
Definition: omAllocDecl.h:263
syStrategy syConvList ( lists  li,
BOOLEAN  toDel 
)

Definition at line 3119 of file ipshell.cc.

3120 {
3121  int typ0;
3123 
3124  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3125  if (fr != NULL)
3126  {
3127 
3128  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3129  for (int i=result->length-1;i>=0;i--)
3130  {
3131  if (fr[i]!=NULL)
3132  result->fullres[i] = idCopy(fr[i]);
3133  }
3134  result->list_length=result->length;
3135  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3136  }
3137  else
3138  {
3139  omFreeSize(result, sizeof(ssyStrategy));
3140  result = NULL;
3141  }
3142  if (toDel) li->Clean();
3143  return result;
3144 }
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:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:161
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:73
#define NULL
Definition: omList.c:10
void Clean(ring r=currRing)
Definition: lists.h:25
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35
lists syConvRes ( syStrategy  syzstr,
BOOLEAN  toDel,
int  add_row_shift 
)

Definition at line 3046 of file ipshell.cc.

3047 {
3048  resolvente fullres = syzstr->fullres;
3049  resolvente minres = syzstr->minres;
3050 
3051  const int length = syzstr->length;
3052 
3053  if ((fullres==NULL) && (minres==NULL))
3054  {
3055  if (syzstr->hilb_coeffs==NULL)
3056  { // La Scala
3057  fullres = syReorder(syzstr->res, length, syzstr);
3058  }
3059  else
3060  { // HRES
3061  minres = syReorder(syzstr->orderedRes, length, syzstr);
3062  syKillEmptyEntres(minres, length);
3063  }
3064  }
3065 
3066  resolvente tr;
3067  int typ0=IDEAL_CMD;
3068 
3069  if (minres!=NULL)
3070  tr = minres;
3071  else
3072  tr = fullres;
3073 
3074  resolvente trueres=NULL; intvec ** w=NULL;
3075 
3076  if (length>0)
3077  {
3078  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3079  for (int i=(length)-1;i>=0;i--)
3080  {
3081  if (tr[i]!=NULL)
3082  {
3083  trueres[i] = idCopy(tr[i]);
3084  }
3085  }
3086  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3087  typ0 = MODUL_CMD;
3088  if (syzstr->weights!=NULL)
3089  {
3090  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3091  for (int i=length-1;i>=0;i--)
3092  {
3093  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3094  }
3095  }
3096  }
3097 
3098  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3099  w, add_row_shift);
3100 
3101  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3102 
3103  if (toDel)
3104  syKillComputation(syzstr);
3105  else
3106  {
3107  if( fullres != NULL && syzstr->fullres == NULL )
3108  syzstr->fullres = fullres;
3109 
3110  if( minres != NULL && syzstr->minres == NULL )
3111  syzstr->minres = minres;
3112  }
3113  return li;
3114 }
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:1653
Definition: lists.h:22
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
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:12
resolvente orderedRes
Definition: syz.h:48
Definition: intvec.h:16
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:73
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
const CanonicalForm & w
Definition: facAbsFact.cc:55
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:20
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2209
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1497
#define omAlloc0(size)
Definition: omAllocDecl.h:211
syStrategy syForceMin ( lists  li)

Definition at line 3149 of file ipshell.cc.

3150 {
3151  int typ0;
3153 
3154  resolvente fr = liFindRes(li,&(result->length),&typ0);
3155  result->minres = (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->minres[i] = idCopy(fr[i]);
3160  }
3161  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3162  return result;
3163 }
int length
Definition: syz.h:60
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:161
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:73
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35
void test_cmd ( int  i)

Definition at line 521 of file ipshell.cc.

522 {
523  int ii;
524 
525  if (i<0)
526  {
527  ii= -i;
528  if (ii < 32)
529  {
530  si_opt_1 &= ~Sy_bit(ii);
531  }
532  else if (ii < 64)
533  {
534  si_opt_2 &= ~Sy_bit(ii-32);
535  }
536  else
537  WerrorS("out of bounds\n");
538  }
539  else if (i<32)
540  {
541  ii=i;
542  if (Sy_bit(ii) & kOptions)
543  {
544  Warn("Gerhard, use the option command");
545  si_opt_1 |= Sy_bit(ii);
546  }
547  else if (Sy_bit(ii) & validOpts)
548  si_opt_1 |= Sy_bit(ii);
549  }
550  else if (i<64)
551  {
552  ii=i-32;
553  si_opt_2 |= Sy_bit(ii);
554  }
555  else
556  WerrorS("out of bounds\n");
557 }
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:70
int i
Definition: cfEzgcd.cc:123
BITSET kOptions
Definition: kstd1.cc:55
unsigned si_opt_2
Definition: options.c:6
#define Warn
Definition: emacs.cc:80
void type_cmd ( leftv  v)

Definition at line 251 of file ipshell.cc.

252 {
253  BOOLEAN oldShortOut = FALSE;
254 
255  if (currRing != NULL)
256  {
257  oldShortOut = currRing->ShortOut;
258  currRing->ShortOut = 1;
259  }
260  int t=v->Typ();
261  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
262  switch (t)
263  {
264  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
265  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
266  ((intvec*)(v->Data()))->cols()); break;
267  case MATRIX_CMD:Print(" %u x %u\n" ,
268  MATROWS((matrix)(v->Data())),
269  MATCOLS((matrix)(v->Data())));break;
270  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
271  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
272 
273  case PROC_CMD:
274  case RING_CMD:
275  case IDEAL_CMD:
276  case QRING_CMD: PrintLn(); break;
277 
278  //case INT_CMD:
279  //case STRING_CMD:
280  //case INTVEC_CMD:
281  //case POLY_CMD:
282  //case VECTOR_CMD:
283  //case PACKAGE_CMD:
284 
285  default:
286  break;
287  }
288  v->Print();
289  if (currRing != NULL)
290  currRing->ShortOut = oldShortOut;
291 }
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:327
#define Print
Definition: emacs.cc:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
int Typ()
Definition: subexpr.cc:969
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:12
Definition: intvec.h:16
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:96
Definition: tok.h:126
#define MATROWS(i)
Definition: matpol.h:27
int BOOLEAN
Definition: auxiliary.h:131

Variable Documentation

leftv iiCurrArgs =NULL

Definition at line 84 of file ipshell.cc.

idhdl iiCurrProc =NULL

Definition at line 85 of file ipshell.cc.

BOOLEAN iiDebugMarker =TRUE

Definition at line 979 of file ipshell.cc.

BOOLEAN iiNoKeepRing =TRUE
static

Definition at line 88 of file ipshell.cc.

const char* lastreserved =NULL

Definition at line 86 of file ipshell.cc.

const short MAX_SHORT = 32767

Definition at line 5448 of file ipshell.cc.