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)
 
void rDecomposeC (leftv h, const ring R)
 
void rDecomposeRing (leftv h, const ring R)
 
lists rDecompose (const ring r)
 
void rComposeC (lists L, ring R)
 
void rComposeRing (lists L, ring R)
 
static void rRenameVars (ring R)
 
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 973 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 3015 of file ipshell.cc.

3016 {
3017  semicOK,
3019 
3022 
3029 
3034 
3040 
3043 
3046 
3047 } semicState;
semicState
Definition: ipshell.cc:3015
Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3131 of file ipshell.cc.

Function Documentation

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 2941 of file ipshell.cc.

2942 {
2943  spec.mu = (int)(long)(l->m[0].Data( ));
2944  spec.pg = (int)(long)(l->m[1].Data( ));
2945  spec.n = (int)(long)(l->m[2].Data( ));
2946 
2947  spec.copy_new( spec.n );
2948 
2949  intvec *num = (intvec*)l->m[3].Data( );
2950  intvec *den = (intvec*)l->m[4].Data( );
2951  intvec *mul = (intvec*)l->m[5].Data( );
2952 
2953  for( int i=0; i<spec.n; i++ )
2954  {
2955  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
2956  spec.w[i] = (*mul)[i];
2957  }
2958 }
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:1097
int * w
Definition: semic.h:71
int exprlist_length ( leftv  v)

Definition at line 552 of file ipshell.cc.

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

Definition at line 2977 of file ipshell.cc.

2978 {
2980 
2981  L->Init( 6 );
2982 
2983  intvec *num = new intvec( spec.n );
2984  intvec *den = new intvec( spec.n );
2985  intvec *mult = new intvec( spec.n );
2986 
2987  for( int i=0; i<spec.n; i++ )
2988  {
2989  (*num) [i] = spec.s[i].get_num_si( );
2990  (*den) [i] = spec.s[i].get_den_si( );
2991  (*mult)[i] = spec.w[i];
2992  }
2993 
2994  L->m[0].rtyp = INT_CMD; // milnor number
2995  L->m[1].rtyp = INT_CMD; // geometrical genus
2996  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
2997  L->m[3].rtyp = INTVEC_CMD; // numerators
2998  L->m[4].rtyp = INTVEC_CMD; // denomiantors
2999  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3000 
3001  L->m[0].data = (void*)(long)spec.mu;
3002  L->m[1].data = (void*)(long)spec.pg;
3003  L->m[2].data = (void*)(long)spec.n;
3004  L->m[3].data = (void*)num;
3005  L->m[4].data = (void*)den;
3006  L->m[5].data = (void*)mult;
3007 
3008  return L;
3009 }
#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 5984 of file ipshell.cc.

5985 {
5986  memset(res,0,sizeof(sleftv));
5987  res->rtyp=a->Typ();
5988  switch (res->rtyp /*a->Typ()*/)
5989  {
5990  case INTVEC_CMD:
5991  case INTMAT_CMD:
5992  return iiApplyINTVEC(res,a,op,proc);
5993  case BIGINTMAT_CMD:
5994  return iiApplyBIGINTMAT(res,a,op,proc);
5995  case IDEAL_CMD:
5996  case MODUL_CMD:
5997  case MATRIX_CMD:
5998  return iiApplyIDEAL(res,a,op,proc);
5999  case LIST_CMD:
6000  return iiApplyLIST(res,a,op,proc);
6001  }
6002  WerrorS("first argument to `apply` must allow an index");
6003  return TRUE;
6004 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
BOOLEAN iiApplyBIGINTMAT(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:5942
BOOLEAN iiApplyIDEAL(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:5947
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:23
int Typ()
Definition: subexpr.cc:955
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:5952
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:5910
BOOLEAN iiApplyBIGINTMAT ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 5942 of file ipshell.cc.

5943 {
5944  WerrorS("not implemented");
5945  return TRUE;
5946 }
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:23
BOOLEAN iiApplyIDEAL ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 5947 of file ipshell.cc.

5948 {
5949  WerrorS("not implemented");
5950  return TRUE;
5951 }
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:23
BOOLEAN iiApplyINTVEC ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 5910 of file ipshell.cc.

5911 {
5912  intvec *aa=(intvec*)a->Data();
5913  sleftv tmp_out;
5914  sleftv tmp_in;
5915  leftv curr=res;
5916  BOOLEAN bo=FALSE;
5917  for(int i=0;i<aa->length(); i++)
5918  {
5919  memset(&tmp_in,0,sizeof(tmp_in));
5920  tmp_in.rtyp=INT_CMD;
5921  tmp_in.data=(void*)(long)(*aa)[i];
5922  if (proc==NULL)
5923  bo=iiExprArith1(&tmp_out,&tmp_in,op);
5924  else
5925  bo=jjPROC(&tmp_out,proc,&tmp_in);
5926  if (bo)
5927  {
5928  res->CleanUp(currRing);
5929  Werror("apply fails at index %d",i+1);
5930  return TRUE;
5931  }
5932  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
5933  else
5934  {
5935  curr->next=(leftv)omAllocBin(sleftv_bin);
5936  curr=curr->next;
5937  memcpy(curr,&tmp_out,sizeof(tmp_out));
5938  }
5939  }
5940  return FALSE;
5941 }
#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:8313
#define FALSE
Definition: auxiliary.h:140
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1606
#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:307
void * Data()
Definition: subexpr.cc:1097
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 5952 of file ipshell.cc.

5953 {
5954  lists aa=(lists)a->Data();
5955  sleftv tmp_out;
5956  sleftv tmp_in;
5957  leftv curr=res;
5958  BOOLEAN bo=FALSE;
5959  for(int i=0;i<=aa->nr; i++)
5960  {
5961  memset(&tmp_in,0,sizeof(tmp_in));
5962  tmp_in.Copy(&(aa->m[i]));
5963  if (proc==NULL)
5964  bo=iiExprArith1(&tmp_out,&tmp_in,op);
5965  else
5966  bo=jjPROC(&tmp_out,proc,&tmp_in);
5967  tmp_in.CleanUp();
5968  if (bo)
5969  {
5970  res->CleanUp(currRing);
5971  Werror("apply fails at index %d",i+1);
5972  return TRUE;
5973  }
5974  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
5975  else
5976  {
5977  curr->next=(leftv)omAllocBin(sleftv_bin);
5978  curr=curr->next;
5979  memcpy(curr,&tmp_out,sizeof(tmp_out));
5980  }
5981  }
5982  return FALSE;
5983 }
#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:8313
#define FALSE
Definition: auxiliary.h:140
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1606
#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:643
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:307
void * Data()
Definition: subexpr.cc:1097
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 6033 of file ipshell.cc.

6034 {
6035  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6036  // find end of s:
6037  int end_s=strlen(s);
6038  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6039  s[end_s+1]='\0';
6040  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6041  sprintf(name,"%s->%s",a,s);
6042  // find start of last expression
6043  int start_s=end_s-1;
6044  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6045  if (start_s<0) // ';' not found
6046  {
6047  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6048  }
6049  else // s[start_s] is ';'
6050  {
6051  s[start_s]='\0';
6052  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6053  }
6054  memset(r,0,sizeof(*r));
6055  // now produce procinfo for PROC_CMD:
6056  r->data = (void *)omAlloc0Bin(procinfo_bin);
6057  ((procinfo *)(r->data))->language=LANG_NONE;
6058  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6059  ((procinfo *)r->data)->data.s.body=ss;
6060  omFree(name);
6061  r->rtyp=PROC_CMD;
6062  //r->rtyp=STRING_CMD;
6063  //r->data=ss;
6064  return FALSE;
6065 }
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:976
#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 6067 of file ipshell.cc.

6068 {
6069  int t=arg->Typ();
6070  char* ring_name=(char*)r->Name();
6071  ring_name=omStrDup(ring_name);
6072  if ((t==RING_CMD) ||(t==QRING_CMD))
6073  {
6074  sleftv tmp;
6075  memset(&tmp,0,sizeof(tmp));
6076  tmp.rtyp=IDHDL;
6077  tmp.data=(char*)rDefault(ring_name);
6078  if (tmp.data!=NULL)
6079  {
6080  BOOLEAN b=iiAssign(&tmp,arg);
6081  if (b) return TRUE;
6082  rSetHdl(ggetid(ring_name));
6083  omFree(ring_name);
6084  return FALSE;
6085  }
6086  else
6087  return TRUE;
6088  }
6089  else if (t==CRING_CMD)
6090  {
6091  sleftv tmp;
6092  sleftv n;
6093  memset(&n,0,sizeof(n));
6094  n.name=ring_name;
6095  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6096  if (iiAssign(&tmp,arg)) return TRUE;
6097  //Print("create %s\n",r->Name());
6098  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6099  return FALSE;
6100  }
6101  return TRUE;// not handled -> error for now
6102 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:955
const char * Name()
Definition: subexpr.h:121
#define IDHDL
Definition: tok.h:35
idhdl rDefault(const char *s)
Definition: ipshell.cc:1520
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:1112
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
Definition: tok.h:126
void rSetHdl(idhdl h)
Definition: ipshell.cc:4696
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:487
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1772
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1167 of file ipshell.cc.

1168 {
1169  // <string1...stringN>,<proc>
1170  // known: args!=NULL, l>=1
1171  int l=args->listLength();
1172  int ll=0;
1173  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1174  if (ll!=(l-1)) return FALSE;
1175  leftv h=args;
1176  short *t=(short*)omAlloc(l*sizeof(short));
1177  t[0]=l-1;
1178  int b;
1179  int i;
1180  for(i=1;i<l;i++,h=h->next)
1181  {
1182  if (h->Typ()!=STRING_CMD)
1183  {
1184  omFree(t);
1185  Werror("arg %d is not a string",i);
1186  return TRUE;
1187  }
1188  int tt;
1189  b=IsCmd((char *)h->Data(),tt);
1190  if(b) t[i]=tt;
1191  else
1192  {
1193  omFree(t);
1194  Werror("arg %d is not a type name",i);
1195  return TRUE;
1196  }
1197  }
1198  if (h->Typ()!=PROC_CMD)
1199  {
1200  omFree(t);
1201  Werror("last arg (%d) is not a proc",i);
1202  return TRUE;
1203  }
1204  b=iiCheckTypes(iiCurrArgs,t,0);
1205  omFree(t);
1206  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1207  {
1208  BOOLEAN err;
1209  //Print("branchTo: %s\n",h->Name());
1210  iiCurrProc=(idhdl)h->data;
1212  if( pi->data.s.body==NULL )
1213  {
1215  if (pi->data.s.body==NULL) return TRUE;
1216  }
1217  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1218  {
1219  currPack=pi->pack;
1222  //Print("set pack=%s\n",IDID(currPackHdl));
1223  }
1224  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1226  if (iiCurrArgs!=NULL)
1227  {
1228  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1229  iiCurrArgs->CleanUp();
1231  iiCurrArgs=NULL;
1232  }
1233  return 2-err;
1234  }
1235  return FALSE;
1236 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
idhdl currPackHdl
Definition: ipid.cc:60
#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:233
#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:6122
package currPack
Definition: ipid.cc:62
leftv iiCurrArgs
Definition: ipshell.cc:84
void CleanUp(ring r=currRing)
Definition: subexpr.cc:307
idhdl packFindHdl(package r)
Definition: ipid.cc:729
void iiCheckPack(package &p)
Definition: ipshell.cc:1504
#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:8722
#define Warn
Definition: emacs.cc:80
void iiCheckPack ( package p)

Definition at line 1504 of file ipshell.cc.

1505 {
1506  if (p==basePack) return;
1507 
1508  idhdl t=basePack->idroot;
1509 
1510  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1511 
1512  if (t==NULL)
1513  {
1514  WarnS("package not found\n");
1515  p=basePack;
1516  }
1517  return;
1518 }
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:63
BOOLEAN iiCheckRing ( int  i)

Definition at line 1460 of file ipshell.cc.

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

6123 {
6124  if (args==NULL)
6125  {
6126  if (type_list[0]==0) return TRUE;
6127  else
6128  {
6129  if (report) WerrorS("no arguments expected");
6130  return FALSE;
6131  }
6132  }
6133  int l=args->listLength();
6134  if (l!=(int)type_list[0])
6135  {
6136  if (report) iiReportTypes(0,l,type_list);
6137  return FALSE;
6138  }
6139  for(int i=1;i<=l;i++,args=args->next)
6140  {
6141  short t=type_list[i];
6142  if (t!=ANY_TYPE)
6143  {
6144  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6145  || (t!=args->Typ()))
6146  {
6147  if (report) iiReportTypes(i,args->Typ(),type_list);
6148  return FALSE;
6149  }
6150  }
6151  }
6152  return TRUE;
6153 }
#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:23
#define IDHDL
Definition: tok.h:35
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6104
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 854 of file ipshell.cc.

855 {
856  int i;
857  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
858 
859  for (i=0; i<l; i++)
860  if (r[i]!=NULL) res[i]=idCopy(r[i]);
861  return res;
862 }
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:76
#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 974 of file ipshell.cc.

975 {
976 #ifdef HAVE_SDB
977  sdb_flags=1;
978 #endif
979  Print("\n-- break point in %s --\n",VoiceName());
981  char * s;
983  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
984  loop
985  {
986  memset(s,0,80);
988  if (s[BREAK_LINE_LENGTH-1]!='\0')
989  {
990  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
991  }
992  else
993  break;
994  }
995  if (*s=='\n')
996  {
998  }
999 #if MDEBUG
1000  else if(strncmp(s,"cont;",5)==0)
1001  {
1003  }
1004 #endif /* MDEBUG */
1005  else
1006  {
1007  strcat( s, "\n;~\n");
1008  newBuffer(s,BT_execute);
1009  }
1010 }
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:972
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:973
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 1112 of file ipshell.cc.

1113 {
1114  BOOLEAN res=FALSE;
1115  const char *id = name->name;
1116 
1117  memset(sy,0,sizeof(sleftv));
1118  if ((name->name==NULL)||(isdigit(name->name[0])))
1119  {
1120  WerrorS("object to declare is not a name");
1121  res=TRUE;
1122  }
1123  else
1124  {
1125  if (TEST_V_ALLWARN
1126  && (name->rtyp!=0)
1127  && (name->rtyp!=IDHDL)
1128  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1129  {
1130  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1132  }
1133  {
1134  sy->data = (char *)enterid(id,lev,t,root,init_b);
1135  }
1136  if (sy->data!=NULL)
1137  {
1138  sy->rtyp=IDHDL;
1139  currid=sy->name=IDID((idhdl)sy->data);
1140  // name->name=NULL; /* used in enterid */
1141  //sy->e = NULL;
1142  if (name->next!=NULL)
1143  {
1145  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1146  }
1147  }
1148  else res=TRUE;
1149  }
1150  name->CleanUp();
1151  return res;
1152 }
#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:23
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:256
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
idhdl currRingHdl
Definition: ipid.cc:64
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:1112
#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:307
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 1154 of file ipshell.cc.

1155 {
1156  attr at=NULL;
1157  if (iiCurrProc!=NULL)
1158  at=iiCurrProc->attribute->get("default_arg");
1159  if (at==NULL)
1160  return FALSE;
1161  sleftv tmp;
1162  memset(&tmp,0,sizeof(sleftv));
1163  tmp.rtyp=at->atyp;
1164  tmp.data=at->CopyA();
1165  return iiAssign(p,&tmp);
1166 }
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:1918
#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:1772
BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1380 of file ipshell.cc.

1381 {
1382  BOOLEAN nok=FALSE;
1383  leftv r=v;
1384  while (v!=NULL)
1385  {
1386  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1387  {
1388  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1389  nok=TRUE;
1390  }
1391  else
1392  {
1393  if(iiInternalExport(v, toLev))
1394  {
1395  r->CleanUp();
1396  return TRUE;
1397  }
1398  }
1399  v=v->next;
1400  }
1401  r->CleanUp();
1402  return nok;
1403 }
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:1272
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:307
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 1406 of file ipshell.cc.

1407 {
1408 #ifdef SINGULAR_4_1
1409  if ((pack==basePack)&&(pack!=currPack))
1410  { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1411 #endif
1412  BOOLEAN nok=FALSE;
1413  leftv rv=v;
1414  while (v!=NULL)
1415  {
1416  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1417  )
1418  {
1419  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1420  nok=TRUE;
1421  }
1422  else
1423  {
1424  idhdl old=pack->idroot->get( v->name,toLev);
1425  if (old!=NULL)
1426  {
1427  if ((pack==currPack) && (old==(idhdl)v->data))
1428  {
1429  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1430  break;
1431  }
1432  else if (IDTYP(old)==v->Typ())
1433  {
1434  if (BVERBOSE(V_REDEFINE))
1435  {
1436  Warn("redefining %s",IDID(old));
1437  }
1438  v->name=omStrDup(v->name);
1439  killhdl2(old,&(pack->idroot),currRing);
1440  }
1441  else
1442  {
1443  rv->CleanUp();
1444  return TRUE;
1445  }
1446  }
1447  //Print("iiExport: pack=%s\n",IDID(root));
1448  if(iiInternalExport(v, toLev, pack))
1449  {
1450  rv->CleanUp();
1451  return TRUE;
1452  }
1453  }
1454  v=v->next;
1455  }
1456  rv->CleanUp();
1457  return nok;
1458 }
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:955
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:90
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:400
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:1272
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:63
package currPack
Definition: ipid.cc:62
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:307
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 1480 of file ipshell.cc.

1481 {
1482  int i;
1483  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1484  poly po=NULL;
1486  {
1487  scComputeHC(I,currRing->qideal,ak,po);
1488  if (po!=NULL)
1489  {
1490  pGetCoeff(po)=nInit(1);
1491  for (i=rVar(currRing); i>0; i--)
1492  {
1493  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1494  }
1495  pSetComp(po,ak);
1496  pSetm(po);
1497  }
1498  }
1499  else
1500  po=pOne();
1501  return po;
1502 }
#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
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
BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:176
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1272 of file ipshell.cc.

1273 {
1274  idhdl h=(idhdl)v->data;
1275  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1276  if (IDLEV(h)==0)
1277  {
1278  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1279  }
1280  else
1281  {
1282  h=IDROOT->get(v->name,toLev);
1283  idhdl *root=&IDROOT;
1284  if ((h==NULL)&&(currRing!=NULL))
1285  {
1286  h=currRing->idroot->get(v->name,toLev);
1287  root=&currRing->idroot;
1288  }
1289  BOOLEAN keepring=FALSE;
1290  if ((h!=NULL)&&(IDLEV(h)==toLev))
1291  {
1292  if (IDTYP(h)==v->Typ())
1293  {
1294  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1295  && (v->Data()==IDDATA(h)))
1296  {
1297  IDRING(h)->ref++;
1298  keepring=TRUE;
1299  IDLEV(h)=toLev;
1300  //WarnS("keepring");
1301  return FALSE;
1302  }
1303  if (BVERBOSE(V_REDEFINE))
1304  {
1305  Warn("redefining %s",IDID(h));
1306  }
1307 #ifdef USE_IILOCALRING
1308  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1309 #else
1311  while (p->next!=NULL) p=p->next;
1312  if ((p->cRing==IDRING(h)) && (!keepring))
1313  {
1314  p->cRing=NULL;
1315  p->cRingHdl=NULL;
1316  }
1317 #endif
1318  killhdl2(h,root,currRing);
1319  }
1320  else
1321  {
1322  return TRUE;
1323  }
1324  }
1325  h=(idhdl)v->data;
1326  IDLEV(h)=toLev;
1327  if (keepring) IDRING(h)->ref--;
1329  //Print("export %s\n",IDID(h));
1330  }
1331  return FALSE;
1332 }
#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:57
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:955
idhdl cRingHdl
Definition: ipid.h:60
int int kStrategy strat if(h==NULL) return NULL
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:400
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:1097
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 1334 of file ipshell.cc.

1335 {
1336  idhdl h=(idhdl)v->data;
1337  if(h==NULL)
1338  {
1339  Warn("'%s': no such identifier\n", v->name);
1340  return FALSE;
1341  }
1342  package frompack=v->req_packhdl;
1343  if (frompack==NULL) frompack=currPack;
1344  if ((RingDependend(IDTYP(h)))
1345  || ((IDTYP(h)==LIST_CMD)
1346  && (lRingDependend(IDLIST(h)))
1347  )
1348  )
1349  {
1350  //Print("// ==> Ringdependent set nesting to 0\n");
1351  return (iiInternalExport(v, toLev));
1352  }
1353  else
1354  {
1355  IDLEV(h)=toLev;
1356  v->req_packhdl=rootpack;
1357  if (h==frompack->idroot)
1358  {
1359  frompack->idroot=h->next;
1360  }
1361  else
1362  {
1363  idhdl hh=frompack->idroot;
1364  while ((hh!=NULL) && (hh->next!=h))
1365  hh=hh->next;
1366  if ((hh!=NULL) && (hh->next==h))
1367  hh->next=h->next;
1368  else
1369  {
1370  Werror("`%s` not found",v->Name());
1371  return TRUE;
1372  }
1373  }
1374  h->next=rootpack->idroot;
1375  rootpack->idroot=h;
1376  }
1377  return FALSE;
1378 }
#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:1272
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:62
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 765 of file ipshell.cc.

767 {
768  lists L=liMakeResolv(r,length,rlen,typ0,weights);
769  int i=0;
770  idhdl h;
771  char * s=(char *)omAlloc(strlen(name)+5);
772 
773  while (i<=L->nr)
774  {
775  sprintf(s,"%s(%d)",name,i+1);
776  if (i==0)
777  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
778  else
779  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
780  if (h!=NULL)
781  {
782  h->data.uideal=(ideal)L->m[i].data;
783  h->attribute=L->m[i].attribute;
785  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
786  }
787  else
788  {
789  idDelete((ideal *)&(L->m[i].data));
790  Warn("cannot define %s",s);
791  }
792  //L->m[i].data=NULL;
793  //L->m[i].rtyp=0;
794  //L->m[i].attribute=NULL;
795  i++;
796  }
797  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
799  omFreeSize((ADDRESS)s,strlen(name)+5);
800 }
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
Definition: lists.h:22
#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
int int kStrategy strat if(h==NULL) return NULL
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:256
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
void idDelete(ideal *h)
delete an ideal
Definition: ideals.h:31
utypes data
Definition: idrec.h:40
#define Warn
Definition: emacs.cc:80
leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 615 of file ipshell.cc.

616 {
617  idhdl w,r;
618  leftv v;
619  int i;
620  nMapFunc nMap;
621 
622  r=IDROOT->get(theMap->preimage,myynest);
623  if ((currPack!=basePack)
624  &&((r==NULL) || ((r->typ != RING_CMD) && (r->typ != QRING_CMD))))
625  r=basePack->idroot->get(theMap->preimage,myynest);
626  if ((r==NULL) && (currRingHdl!=NULL)
627  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
628  {
629  r=currRingHdl;
630  }
631  if ((r!=NULL) && ((r->typ == RING_CMD) || (r->typ== QRING_CMD)))
632  {
633  ring src_ring=IDRING(r);
634  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
635  {
636  Werror("can not map from ground field of %s to current ground field",
637  theMap->preimage);
638  return NULL;
639  }
640  if (IDELEMS(theMap)<src_ring->N)
641  {
642  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
643  IDELEMS(theMap)*sizeof(poly),
644  (src_ring->N)*sizeof(poly));
645  for(i=IDELEMS(theMap);i<src_ring->N;i++)
646  theMap->m[i]=NULL;
647  IDELEMS(theMap)=src_ring->N;
648  }
649  if (what==NULL)
650  {
651  WerrorS("argument of a map must have a name");
652  }
653  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
654  {
655  char *save_r=NULL;
657  sleftv tmpW;
658  memset(&tmpW,0,sizeof(sleftv));
659  tmpW.rtyp=IDTYP(w);
660  if (tmpW.rtyp==MAP_CMD)
661  {
662  tmpW.rtyp=IDEAL_CMD;
663  save_r=IDMAP(w)->preimage;
664  IDMAP(w)->preimage=0;
665  }
666  tmpW.data=IDDATA(w);
667  // check overflow
668  BOOLEAN overflow=FALSE;
669  if ((tmpW.rtyp==IDEAL_CMD)
670  || (tmpW.rtyp==MODUL_CMD)
671  || (tmpW.rtyp==MAP_CMD))
672  {
673  ideal id=(ideal)tmpW.data;
674  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
675  {
676  if (theMap->m[j]!=NULL)
677  {
678  long deg_monexp=pTotaldegree(theMap->m[j]);
679  for(int i=IDELEMS(id)-1;i>=0;i--)
680  {
681  poly p=id->m[i];
682  if ((p!=NULL) && (p_Totaldegree(p,src_ring)!=0) &&
683  ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)p_Totaldegree(p,src_ring)/2)))
684  {
685  overflow=TRUE;
686  break;
687  }
688  }
689  }
690  }
691  }
692  else if (tmpW.rtyp==POLY_CMD)
693  {
694  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
695  {
696  if (theMap->m[j]!=NULL)
697  {
698  long deg_monexp=pTotaldegree(theMap->m[j]);
699  poly p=(poly)tmpW.data;
700  if ((p!=NULL) && (p_Totaldegree(p,src_ring)!=0) &&
701  ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)p_Totaldegree(p,src_ring)/2)))
702  {
703  overflow=TRUE;
704  break;
705  }
706  }
707  }
708  }
709  if (overflow)
710  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
711 #if 0
712  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
713  {
714  v->rtyp=tmpW.rtyp;
715  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
716  }
717  else
718 #endif
719  {
720 #ifdef FAST_MAP
721  if ((tmpW.rtyp==IDEAL_CMD) && (nMap == ndCopyMap)
722 #ifdef HAVE_PLURAL
723  && (!rIsPluralRing(currRing))
724 #endif
725  )
726  {
727  v->rtyp=IDEAL_CMD;
728  char *tmp = theMap->preimage;
729  theMap->preimage=(char*)1L;
730  // map gets 1 as its rank (as an ideal)
731  v->data=fast_map(IDIDEAL(w), src_ring, (ideal)theMap, currRing);
732  theMap->preimage=tmp; // map gets its preimage back
733  }
734  else
735 #endif
736  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
737  {
738  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
740  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
741  return NULL;
742  }
743  }
744  if (save_r!=NULL)
745  {
746  IDMAP(w)->preimage=save_r;
747  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
748  v->rtyp=MAP_CMD;
749  }
750  return v;
751  }
752  else
753  {
754  Werror("%s undefined in %s",what,theMap->preimage);
755  }
756  }
757  else
758  {
759  Werror("cannot find preimage %s",theMap->preimage);
760  }
761  return NULL;
762 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#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:23
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
int int kStrategy strat if(h==NULL) return NULL
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:90
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:64
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:63
#define IDRING(a)
Definition: ipid.h:126
const CanonicalForm & w
Definition: facAbsFact.cc:55
package currPack
Definition: ipid.cc:62
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 1237 of file ipshell.cc.

1238 {
1239  if (iiCurrArgs==NULL)
1240  {
1241  if (strcmp(p->name,"#")==0)
1242  return iiDefaultParameter(p);
1243  Werror("not enough arguments for proc %s",VoiceName());
1244  p->CleanUp();
1245  return TRUE;
1246  }
1247  leftv h=iiCurrArgs;
1248  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1249  BOOLEAN is_default_list=FALSE;
1250  if (strcmp(p->name,"#")==0)
1251  {
1252  is_default_list=TRUE;
1253  rest=NULL;
1254  }
1255  else
1256  {
1257  h->next=NULL;
1258  }
1259  BOOLEAN res=iiAssign(p,h);
1260  if (is_default_list)
1261  {
1262  iiCurrArgs=NULL;
1263  }
1264  else
1265  {
1266  iiCurrArgs=rest;
1267  }
1268  h->CleanUp();
1270  return res;
1271 }
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:1154
leftv iiCurrArgs
Definition: ipshell.cc:84
void CleanUp(ring r=currRing)
Definition: subexpr.cc:307
#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:1772
int iiRegularity ( lists  L)

Definition at line 946 of file ipshell.cc.

947 {
948  int len,reg,typ0;
949 
950  resolvente r=liFindRes(L,&len,&typ0);
951 
952  if (r==NULL)
953  return -2;
954  intvec *weights=NULL;
955  int add_row_shift=0;
956  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
957  if (ww!=NULL)
958  {
959  weights=ivCopy(ww);
960  add_row_shift = ww->min_in();
961  (*weights) -= add_row_shift;
962  }
963  //Print("attr:%x\n",weights);
964 
965  intvec *dummy=syBetti(r,len,&reg,weights);
966  if (weights!=NULL) delete weights;
967  delete dummy;
968  omFreeSize((ADDRESS)r,len*sizeof(ideal));
969  return reg+1+add_row_shift;
970 }
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:137
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:110
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 6104 of file ipshell.cc.

6105 {
6106  char *buf=(char*)omAlloc(250);
6107  buf[0]='\0';
6108  if (nr==0)
6109  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6110  else
6111  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6112  for(int i=1;i<=T[0];i++)
6113  {
6114  strcat(buf,"`");
6115  strcat(buf,Tok2Cmdname(T[i]));
6116  strcat(buf,"`");
6117  if (i<T[0]) strcat(buf,",");
6118  }
6119  WerrorS(buf);
6120 }
void WerrorS(const char *s)
Definition: feFopen.cc:23
#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 6006 of file ipshell.cc.

6007 {
6008  // assume a: level
6009  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6010  {
6011  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6012  char assume_yylinebuf[80];
6013  strncpy(assume_yylinebuf,my_yylinebuf,79);
6014  int lev=(long)a->Data();
6015  int startlev=0;
6016  idhdl h=ggetid("assumeLevel");
6017  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6018  if(lev <=startlev)
6019  {
6020  BOOLEAN bo=b->Eval();
6021  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6022  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6023  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6024  }
6025  }
6026  b->CleanUp();
6027  a->CleanUp();
6028  return FALSE;
6029 }
int Eval()
Definition: subexpr.cc:1721
Definition: tok.h:85
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:23
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:955
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:307
void * Data()
Definition: subexpr.cc:1097
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:487
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 588 of file ipshell.cc.

589 {
590  sleftv vf;
591  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
592  {
593  WerrorS("link expected");
594  return TRUE;
595  }
596  si_link l=(si_link)vf.Data();
597  if (vf.next == NULL)
598  {
599  WerrorS("write: need at least two arguments");
600  return TRUE;
601  }
602 
603  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
604  if (b)
605  {
606  const char *s;
607  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
608  else s=sNoName;
609  Werror("cannot write to %s",s);
610  }
611  vf.CleanUp();
612  return b;
613 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:290
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:23
int Typ()
Definition: subexpr.cc:955
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:287
void CleanUp(ring r=currRing)
Definition: subexpr.cc:307
void * Data()
Definition: subexpr.cc:1097
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 885 of file ipshell.cc.

886 {
887  sleftv tmp;
888  memset(&tmp,0,sizeof(tmp));
889  tmp.rtyp=INT_CMD;
890  tmp.data=(void *)1;
891  if ((u->Typ()==IDEAL_CMD)
892  || (u->Typ()==MODUL_CMD))
893  return jjBETTI2_ID(res,u,&tmp);
894  else
895  return jjBETTI2(res,u,&tmp);
896 }
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:919
int Typ()
Definition: subexpr.cc:955
void * data
Definition: subexpr.h:89
int rtyp
Definition: subexpr.h:92
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:898
BOOLEAN jjBETTI2 ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 919 of file ipshell.cc.

920 {
921  resolvente r;
922  int len;
923  int reg,typ0;
924  lists l=(lists)u->Data();
925 
926  intvec *weights=NULL;
927  int add_row_shift=0;
928  intvec *ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
929  if (ww!=NULL)
930  {
931  weights=ivCopy(ww);
932  add_row_shift = ww->min_in();
933  (*weights) -= add_row_shift;
934  }
935  //Print("attr:%x\n",weights);
936 
937  r=liFindRes(l,&len,&typ0);
938  if (r==NULL) return TRUE;
939  res->data=(char *)syBetti(r,len,&reg,weights,(int)(long)v->Data());
940  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
941  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
942  if (weights!=NULL) delete weights;
943  return FALSE;
944 }
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:137
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:110
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:1097
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 898 of file ipshell.cc.

899 {
901  l->Init(1);
902  l->m[0].rtyp=u->Typ();
903  l->m[0].data=u->Data();
904  attr *a=u->Attribute();
905  if (a!=NULL)
906  l->m[0].attribute=*a;
907  sleftv tmp2;
908  memset(&tmp2,0,sizeof(tmp2));
909  tmp2.rtyp=LIST_CMD;
910  tmp2.data=(void *)l;
911  BOOLEAN r=jjBETTI2(res,&tmp2,v);
912  l->m[0].data=NULL;
913  l->m[0].attribute=NULL;
914  l->m[0].rtyp=DEF_CMD;
915  l->Clean();
916  return r;
917 }
#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:1352
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:919
int Typ()
Definition: subexpr.cc:955
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:1097
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 2928 of file ipshell.cc.

2929 {
2930  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
2931  return (res->data==NULL);
2932 }
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:1097
static void jjINT_S_TO_ID ( int  n,
int *  e,
leftv  res 
)
static

Definition at line 5849 of file ipshell.cc.

5850 {
5851  if (n==0) n=1;
5852  ideal l=idInit(n,1);
5853  int i;
5854  poly p;
5855  for(i=rVar(currRing);i>0;i--)
5856  {
5857  if (e[i]>0)
5858  {
5859  n--;
5860  p=pOne();
5861  pSetExp(p,i,1);
5862  pSetm(p);
5863  l->m[n]=p;
5864  if (n==0) break;
5865  }
5866  }
5867  res->data=(char*)l;
5868  setFlag(res,FLAG_STD);
5869  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
5870 }
#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
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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 864 of file ipshell.cc.

865 {
866  int len=0;
867  int typ0;
868  lists L=(lists)v->Data();
869  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
870  int add_row_shift = 0;
871  if (weights==NULL)
872  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
873  if (weights!=NULL) add_row_shift=weights->min_in();
874  resolvente rr=liFindRes(L,&len,&typ0);
875  if (rr==NULL) return TRUE;
876  resolvente r=iiCopyRes(rr,len);
877 
878  syMinimizeResolvente(r,len,0);
879  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
880  len++;
881  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
882  return FALSE;
883 }
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:110
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:854
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:1097
ideal * resolvente
Definition: ideals.h:20
BOOLEAN jjPROC ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 1606 of file iparith.cc.

1607 {
1608  void *d;
1609  Subexpr e;
1610  int typ;
1611  BOOLEAN t=FALSE;
1612  idhdl tmp_proc=NULL;
1613  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1614  {
1615  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1616  tmp_proc->id="_auto";
1617  tmp_proc->typ=PROC_CMD;
1618  tmp_proc->data.pinf=(procinfo *)u->Data();
1619  tmp_proc->ref=1;
1620  d=u->data; u->data=(void *)tmp_proc;
1621  e=u->e; u->e=NULL;
1622  t=TRUE;
1623  typ=u->rtyp; u->rtyp=IDHDL;
1624  }
1625  BOOLEAN sl;
1626  if (u->req_packhdl==currPack)
1627  sl = iiMake_proc((idhdl)u->data,NULL,v);
1628  else
1629  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1630  if (t)
1631  {
1632  u->rtyp=typ;
1633  u->data=d;
1634  u->e=e;
1635  omFreeSize(tmp_proc,sizeof(idrec));
1636  }
1637  if (sl) return TRUE;
1638  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1639  iiRETURNEXPR.Init();
1640  return FALSE;
1641 }
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:62
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1097
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 2921 of file ipshell.cc.

2922 {
2923  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
2924  (poly)w->CopyD(), currRing);
2925  return errorreported;
2926 }
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:22
polyrec * poly
Definition: hilb.h:10
void * CopyD(int t)
Definition: subexpr.cc:662
BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 5879 of file ipshell.cc.

5880 {
5881  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
5882  ideal I=(ideal)u->Data();
5883  int i;
5884  int n=0;
5885  for(i=I->nrows*I->ncols-1;i>=0;i--)
5886  {
5887  int n0=pGetVariables(I->m[i],e);
5888  if (n0>n) n=n0;
5889  }
5890  jjINT_S_TO_ID(n,e,res);
5891  return FALSE;
5892 }
#define FALSE
Definition: auxiliary.h:140
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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:5849
#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:1097
#define omAlloc0(size)
Definition: omAllocDecl.h:211
BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 5871 of file ipshell.cc.

5872 {
5873  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
5874  int n=pGetVariables((poly)u->Data(),e);
5875  jjINT_S_TO_ID(n,e,res);
5876  return FALSE;
5877 }
#define FALSE
Definition: auxiliary.h:140
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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:5849
#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:1097
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211
ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 5804 of file ipshell.cc.

5805 {
5806  //test|=Sy_bit(OPT_PROT);
5807  idhdl save_ringhdl=currRingHdl;
5808  ideal resid;
5809  idhdl new_ring=NULL;
5810  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
5811  {
5812  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
5813  new_ring=currRingHdl;
5815  }
5816  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
5817  idhdl h=ggetid("groebner");
5818  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
5819  u.name=IDID(h);
5820 
5821  sleftv res; memset(&res,0,sizeof(res));
5822  if(jjPROC(&res,&u,&v))
5823  {
5824  resid=kStd(F,Q,testHomog,NULL);
5825  }
5826  else
5827  {
5828  //printf("typ:%d\n",res.rtyp);
5829  resid=(ideal)(res.data);
5830  }
5831  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
5832  if (new_ring!=NULL)
5833  {
5834  idhdl h=IDROOT;
5835  if (h==new_ring) IDROOT=h->next;
5836  else
5837  {
5838  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
5839  if (h!=NULL) h->next=h->next->next;
5840  }
5841  if (h!=NULL) omFreeSize(h,sizeof(*h));
5842  }
5843  currRingHdl=save_ringhdl;
5844  u.CleanUp();
5845  v.CleanUp();
5846  return resid;
5847 }
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:1606
#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:256
const char * name
Definition: subexpr.h:88
idhdl currRingHdl
Definition: ipid.cc:64
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:307
static Poly * h
Definition: janet.cc:978
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:487
#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:955
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:64
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1565
#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:63
#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:400
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
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
#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
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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:400
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:63
#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 2904 of file ipshell.cc.

2905 {
2906  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
2907  if (res->data==NULL)
2908  res->data=(char *)new intvec(rVar(currRing));
2909  return FALSE;
2910 }
#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:1097
BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 2882 of file ipshell.cc.

2883 {
2884  ideal F=(ideal)id->Data();
2885  intvec * iv = new intvec(rVar(currRing));
2886  polyset s;
2887  int sl, n, i;
2888  int *x;
2889 
2890  res->data=(char *)iv;
2891  s = F->m;
2892  sl = IDELEMS(F) - 1;
2893  n = rVar(currRing);
2894  double wNsqr = (double)2.0 / (double)n;
2896  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
2897  wCall(s, sl, x, wNsqr, currRing);
2898  for (i = n; i!=0; i--)
2899  (*iv)[i-1] = x[i + n + 1];
2900  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
2901  return FALSE;
2902 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:140
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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:1097
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:322
#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:32
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
char buffer[1024]
Definition: run.c:54
#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:516
#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:64
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:128
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:5894
int rows() const
Definition: bigintmat.h:129
#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:130
#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  && (IDTYP(h)!=CRING_CMD))
490  || (typ == IDTYP(h))
491  || ((typ==RING_CMD) &&(IDTYP(h)==CRING_CMD))
492  || ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD)))
493  {
494  list1(prefix,h,start==currRingHdl, fullname);
495  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
496  && (really_all || (all && (h==currRingHdl)))
497  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
498  {
499  list_cmd(0,IDID(h),"// ",FALSE);
500  }
501  if (IDTYP(h)==PACKAGE_CMD && really_all)
502  {
503  package save_p=currPack;
504  currPack=IDPACKAGE(h);
505  list_cmd(0,IDID(h),"// ",FALSE);
506  currPack=save_p;
507  }
508  }
509  h = IDNEXT(h);
510  }
511  currPack=savePack;
512 }
#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:64
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:63
#define IDRING(a)
Definition: ipid.h:126
package currPack
Definition: ipid.cc:62
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:487
void list_error ( semicState  state)

Definition at line 3049 of file ipshell.cc.

3050 {
3051  switch( state )
3052  {
3053  case semicListTooShort:
3054  WerrorS( "the list is too short" );
3055  break;
3056  case semicListTooLong:
3057  WerrorS( "the list is too long" );
3058  break;
3059 
3061  WerrorS( "first element of the list should be int" );
3062  break;
3064  WerrorS( "second element of the list should be int" );
3065  break;
3067  WerrorS( "third element of the list should be int" );
3068  break;
3070  WerrorS( "fourth element of the list should be intvec" );
3071  break;
3073  WerrorS( "fifth element of the list should be intvec" );
3074  break;
3076  WerrorS( "sixth element of the list should be intvec" );
3077  break;
3078 
3079  case semicListNNegative:
3080  WerrorS( "first element of the list should be positive" );
3081  break;
3083  WerrorS( "wrong number of numerators" );
3084  break;
3086  WerrorS( "wrong number of denominators" );
3087  break;
3089  WerrorS( "wrong number of multiplicities" );
3090  break;
3091 
3092  case semicListMuNegative:
3093  WerrorS( "the Milnor number should be positive" );
3094  break;
3095  case semicListPgNegative:
3096  WerrorS( "the geometrical genus should be nonnegative" );
3097  break;
3098  case semicListNumNegative:
3099  WerrorS( "all numerators should be positive" );
3100  break;
3101  case semicListDenNegative:
3102  WerrorS( "all denominators should be positive" );
3103  break;
3104  case semicListMulNegative:
3105  WerrorS( "all multiplicities should be positive" );
3106  break;
3107 
3108  case semicListNotSymmetric:
3109  WerrorS( "it is not symmetric" );
3110  break;
3112  WerrorS( "it is not monotonous" );
3113  break;
3114 
3115  case semicListMilnorWrong:
3116  WerrorS( "the Milnor number is wrong" );
3117  break;
3118  case semicListPGWrong:
3119  WerrorS( "the geometrical genus is wrong" );
3120  break;
3121 
3122  default:
3123  WerrorS( "unspecific error" );
3124  break;
3125  }
3126 }
void WerrorS(const char *s)
Definition: feFopen.cc:23
semicState list_is_spectrum ( lists  l)

Definition at line 3834 of file ipshell.cc.

3835 {
3836  // -------------------
3837  // check list length
3838  // -------------------
3839 
3840  if( l->nr < 5 )
3841  {
3842  return semicListTooShort;
3843  }
3844  else if( l->nr > 5 )
3845  {
3846  return semicListTooLong;
3847  }
3848 
3849  // -------------
3850  // check types
3851  // -------------
3852 
3853  if( l->m[0].rtyp != INT_CMD )
3854  {
3856  }
3857  else if( l->m[1].rtyp != INT_CMD )
3858  {
3860  }
3861  else if( l->m[2].rtyp != INT_CMD )
3862  {
3864  }
3865  else if( l->m[3].rtyp != INTVEC_CMD )
3866  {
3868  }
3869  else if( l->m[4].rtyp != INTVEC_CMD )
3870  {
3872  }
3873  else if( l->m[5].rtyp != INTVEC_CMD )
3874  {
3876  }
3877 
3878  // -------------------------
3879  // check number of entries
3880  // -------------------------
3881 
3882  int mu = (int)(long)(l->m[0].Data( ));
3883  int pg = (int)(long)(l->m[1].Data( ));
3884  int n = (int)(long)(l->m[2].Data( ));
3885 
3886  if( n <= 0 )
3887  {
3888  return semicListNNegative;
3889  }
3890 
3891  intvec *num = (intvec*)l->m[3].Data( );
3892  intvec *den = (intvec*)l->m[4].Data( );
3893  intvec *mul = (intvec*)l->m[5].Data( );
3894 
3895  if( n != num->length( ) )
3896  {
3898  }
3899  else if( n != den->length( ) )
3900  {
3902  }
3903  else if( n != mul->length( ) )
3904  {
3906  }
3907 
3908  // --------
3909  // values
3910  // --------
3911 
3912  if( mu <= 0 )
3913  {
3914  return semicListMuNegative;
3915  }
3916  if( pg < 0 )
3917  {
3918  return semicListPgNegative;
3919  }
3920 
3921  int i;
3922 
3923  for( i=0; i<n; i++ )
3924  {
3925  if( (*num)[i] <= 0 )
3926  {
3927  return semicListNumNegative;
3928  }
3929  if( (*den)[i] <= 0 )
3930  {
3931  return semicListDenNegative;
3932  }
3933  if( (*mul)[i] <= 0 )
3934  {
3935  return semicListMulNegative;
3936  }
3937  }
3938 
3939  // ----------------
3940  // check symmetry
3941  // ----------------
3942 
3943  int j;
3944 
3945  for( i=0, j=n-1; i<=j; i++,j-- )
3946  {
3947  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
3948  (*den)[i] != (*den)[j] ||
3949  (*mul)[i] != (*mul)[j] )
3950  {
3951  return semicListNotSymmetric;
3952  }
3953  }
3954 
3955  // ----------------
3956  // check monotony
3957  // ----------------
3958 
3959  for( i=0, j=1; i<n/2; i++,j++ )
3960  {
3961  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
3962  {
3963  return semicListNotMonotonous;
3964  }
3965  }
3966 
3967  // ---------------------
3968  // check Milnor number
3969  // ---------------------
3970 
3971  for( mu=0, i=0; i<n; i++ )
3972  {
3973  mu += (*mul)[i];
3974  }
3975 
3976  if( mu != (int)(long)(l->m[0].Data( )) )
3977  {
3978  return semicListMilnorWrong;
3979  }
3980 
3981  // -------------------------
3982  // check geometrical genus
3983  // -------------------------
3984 
3985  for( pg=0, i=0; i<n; i++ )
3986  {
3987  if( (*num)[i]<=(*den)[i] )
3988  {
3989  pg += (*mul)[i];
3990  }
3991  }
3992 
3993  if( pg != (int)(long)(l->m[1].Data( )) )
3994  {
3995  return semicListPGWrong;
3996  }
3997 
3998  return semicOK;
3999 }
sleftv * m
Definition: lists.h:45
void mu(int **points, int sizePoints)
Definition: tok.h:85
CanonicalForm num(const CanonicalForm &f)
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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:1097
lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 4649 of file ipshell.cc.

4650 {
4651  int i,j;
4652  int count= self->roots[0]->getAnzRoots(); // number of roots
4653  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
4654 
4655  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
4656 
4657  if ( self->found_roots )
4658  {
4659  listofroots->Init( count );
4660 
4661  for (i=0; i < count; i++)
4662  {
4663  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
4664  onepoint->Init(elem);
4665  for ( j= 0; j < elem; j++ )
4666  {
4667  if ( !rField_is_long_C(currRing) )
4668  {
4669  onepoint->m[j].rtyp=STRING_CMD;
4670  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
4671  }
4672  else
4673  {
4674  onepoint->m[j].rtyp=NUMBER_CMD;
4675  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
4676  }
4677  onepoint->m[j].next= NULL;
4678  onepoint->m[j].name= NULL;
4679  }
4680  listofroots->m[i].rtyp=LIST_CMD;
4681  listofroots->m[i].data=(void *)onepoint;
4682  listofroots->m[j].next= NULL;
4683  listofroots->m[j].name= NULL;
4684  }
4685 
4686  }
4687  else
4688  {
4689  listofroots->Init( 0 );
4690  }
4691 
4692  return listofroots;
4693 }
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 'n'
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 4144 of file ipshell.cc.

4145 {
4146  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4147  return FALSE;
4148 }
#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:1097
BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4150 of file ipshell.cc.

4151 {
4152  if ( !(rField_is_long_R(currRing)) )
4153  {
4154  WerrorS("Ground field not implemented!");
4155  return TRUE;
4156  }
4157 
4158  simplex * LP;
4159  matrix m;
4160 
4161  leftv v= args;
4162  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4163  return TRUE;
4164  else
4165  m= (matrix)(v->CopyD());
4166 
4167  LP = new simplex(MATROWS(m),MATCOLS(m));
4168  LP->mapFromMatrix(m);
4169 
4170  v= v->next;
4171  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4172  return TRUE;
4173  else
4174  LP->m= (int)(long)(v->Data());
4175 
4176  v= v->next;
4177  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4178  return TRUE;
4179  else
4180  LP->n= (int)(long)(v->Data());
4181 
4182  v= v->next;
4183  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4184  return TRUE;
4185  else
4186  LP->m1= (int)(long)(v->Data());
4187 
4188  v= v->next;
4189  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4190  return TRUE;
4191  else
4192  LP->m2= (int)(long)(v->Data());
4193 
4194  v= v->next;
4195  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4196  return TRUE;
4197  else
4198  LP->m3= (int)(long)(v->Data());
4199 
4200 #ifdef mprDEBUG_PROT
4201  Print("m (constraints) %d\n",LP->m);
4202  Print("n (columns) %d\n",LP->n);
4203  Print("m1 (<=) %d\n",LP->m1);
4204  Print("m2 (>=) %d\n",LP->m2);
4205  Print("m3 (==) %d\n",LP->m3);
4206 #endif
4207 
4208  LP->compute();
4209 
4210  lists lres= (lists)omAlloc( sizeof(slists) );
4211  lres->Init( 6 );
4212 
4213  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4214  lres->m[0].data=(void*)LP->mapToMatrix(m);
4215 
4216  lres->m[1].rtyp= INT_CMD; // found a solution?
4217  lres->m[1].data=(void*)(long)LP->icase;
4218 
4219  lres->m[2].rtyp= INTVEC_CMD;
4220  lres->m[2].data=(void*)LP->posvToIV();
4221 
4222  lres->m[3].rtyp= INTVEC_CMD;
4223  lres->m[3].data=(void*)LP->zrovToIV();
4224 
4225  lres->m[4].rtyp= INT_CMD;
4226  lres->m[4].data=(void*)(long)LP->m;
4227 
4228  lres->m[5].rtyp= INT_CMD;
4229  lres->m[5].data=(void*)(long)LP->n;
4230 
4231  res->data= (void*)lres;
4232 
4233  return FALSE;
4234 }
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:23
int Typ()
Definition: subexpr.cc:955
#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:1097
#define MATROWS(i)
Definition: matpol.h:27
int icase
Definition: mpr_numeric.h:201
void * CopyD(int t)
Definition: subexpr.cc:662
BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2648 of file ipshell.cc.

2649 {
2650  int i,j;
2651  matrix result;
2652  ideal id=(ideal)a->Data();
2653 
2654  result =mpNew(IDELEMS(id),rVar(currRing));
2655  for (i=1; i<=IDELEMS(id); i++)
2656  {
2657  for (j=1; j<=rVar(currRing); j++)
2658  {
2659  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2660  }
2661  }
2662  res->data=(char *)result;
2663  return FALSE;
2664 }
#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:1097
#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 2670 of file ipshell.cc.

2671 {
2672  int n=(int)(long)b->Data();
2673  int d=(int)(long)c->Data();
2674  int k,l,sign,row,col;
2675  matrix result;
2676  ideal temp;
2677  BOOLEAN bo;
2678  poly p;
2679 
2680  if ((d>n) || (d<1) || (n<1))
2681  {
2682  res->data=(char *)mpNew(1,1);
2683  return FALSE;
2684  }
2685  int *choise = (int*)omAlloc(d*sizeof(int));
2686  if (id==NULL)
2687  temp=idMaxIdeal(1);
2688  else
2689  temp=(ideal)id->Data();
2690 
2691  k = binom(n,d);
2692  l = k*d;
2693  l /= n-d+1;
2694  result =mpNew(l,k);
2695  col = 1;
2696  idInitChoise(d,1,n,&bo,choise);
2697  while (!bo)
2698  {
2699  sign = 1;
2700  for (l=1;l<=d;l++)
2701  {
2702  if (choise[l-1]<=IDELEMS(temp))
2703  {
2704  p = pCopy(temp->m[choise[l-1]-1]);
2705  if (sign == -1) p = pNeg(p);
2706  sign *= -1;
2707  row = idGetNumberOfChoise(l-1,d,1,n,choise);
2708  MATELEM(result,row,col) = p;
2709  }
2710  }
2711  col++;
2712  idGetNextChoise(d,n,&bo,choise);
2713  }
2714  if (id==NULL) idDelete(&temp);
2715 
2716  res->data=(char *)result;
2717  return FALSE;
2718 }
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:38
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
#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:1097
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)
void idDelete(ideal *h)
delete an ideal
Definition: ideals.h:31
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 4259 of file ipshell.cc.

4260 {
4261 
4262  poly gls;
4263  gls= (poly)(arg1->Data());
4264  int howclean= (int)(long)arg3->Data();
4265 
4266  if ( !(rField_is_R(currRing) ||
4267  rField_is_Q(currRing) ||
4270  {
4271  WerrorS("Ground field not implemented!");
4272  return TRUE;
4273  }
4274 
4277  {
4278  unsigned long int ii = (unsigned long int)arg2->Data();
4279  setGMPFloatDigits( ii, ii );
4280  }
4281 
4282  if ( gls == NULL || pIsConstant( gls ) )
4283  {
4284  WerrorS("Input polynomial is constant!");
4285  return TRUE;
4286  }
4287 
4288  int ldummy;
4289  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4290  // int deg= pDeg( gls );
4291  // int len= pLength( gls );
4292  int i,vpos=0;
4293  poly piter;
4294  lists elist;
4295  lists rlist;
4296 
4297  elist= (lists)omAlloc( sizeof(slists) );
4298  elist->Init( 0 );
4299 
4300  if ( rVar(currRing) > 1 )
4301  {
4302  piter= gls;
4303  for ( i= 1; i <= rVar(currRing); i++ )
4304  if ( pGetExp( piter, i ) )
4305  {
4306  vpos= i;
4307  break;
4308  }
4309  while ( piter )
4310  {
4311  for ( i= 1; i <= rVar(currRing); i++ )
4312  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4313  {
4314  WerrorS("The input polynomial must be univariate!");
4315  return TRUE;
4316  }
4317  pIter( piter );
4318  }
4319  }
4320 
4321  rootContainer * roots= new rootContainer();
4322  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4323  piter= gls;
4324  for ( i= deg; i >= 0; i-- )
4325  {
4326  //if ( piter ) Print("deg %d, pDeg(piter) %d\n",i,pTotaldegree(piter));
4327  if ( piter && pTotaldegree(piter) == i )
4328  {
4329  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4330  //nPrint( pcoeffs[i] );PrintS(" ");
4331  pIter( piter );
4332  }
4333  else
4334  {
4335  pcoeffs[i]= nInit(0);
4336  }
4337  }
4338 
4339 #ifdef mprDEBUG_PROT
4340  for (i=deg; i >= 0; i--)
4341  {
4342  nPrint( pcoeffs[i] );PrintS(" ");
4343  }
4344  PrintLn();
4345 #endif
4346 
4347  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4348  roots->solver( howclean );
4349 
4350  int elem= roots->getAnzRoots();
4351  char *dummy;
4352  int j;
4353 
4354  rlist= (lists)omAlloc( sizeof(slists) );
4355  rlist->Init( elem );
4356 
4358  {
4359  for ( j= 0; j < elem; j++ )
4360  {
4361  rlist->m[j].rtyp=NUMBER_CMD;
4362  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4363  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4364  }
4365  }
4366  else
4367  {
4368  for ( j= 0; j < elem; j++ )
4369  {
4370  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4371  rlist->m[j].rtyp=STRING_CMD;
4372  rlist->m[j].data=(void *)dummy;
4373  }
4374  }
4375 
4376  elist->Clean();
4377  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4378 
4379  // this is (via fillContainer) the same data as in root
4380  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4381  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4382 
4383  delete roots;
4384 
4385  res->rtyp= LIST_CMD;
4386  res->data= (void*)rlist;
4387 
4388  return FALSE;
4389 }
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:322
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:23
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:1097
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 4236 of file ipshell.cc.

4237 {
4238  ideal gls = (ideal)(arg1->Data());
4239  int imtype= (int)(long)arg2->Data();
4240 
4241  uResultant::resMatType mtype= determineMType( imtype );
4242 
4243  // check input ideal ( = polynomial system )
4244  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4245  {
4246  return TRUE;
4247  }
4248 
4249  uResultant *resMat= new uResultant( gls, mtype, false );
4250  if (resMat!=NULL)
4251  {
4252  res->rtyp = MODUL_CMD;
4253  res->data= (void*)resMat->accessResMat()->getMatrix();
4254  if (!errorreported) delete resMat;
4255  }
4256  return errorreported;
4257 }
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)
Definition: mpr_inout.cc:135
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)
Definition: mpr_inout.cc:94
short errorreported
Definition: feFopen.cc:22
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1097
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 4492 of file ipshell.cc.

4493 {
4494  leftv v= args;
4495 
4496  ideal gls;
4497  int imtype;
4498  int howclean;
4499 
4500  // get ideal
4501  if ( v->Typ() != IDEAL_CMD )
4502  return TRUE;
4503  else gls= (ideal)(v->Data());
4504  v= v->next;
4505 
4506  // get resultant matrix type to use (0,1)
4507  if ( v->Typ() != INT_CMD )
4508  return TRUE;
4509  else imtype= (int)(long)v->Data();
4510  v= v->next;
4511 
4512  if (imtype==0)
4513  {
4514  ideal test_id=idInit(1,1);
4515  int j;
4516  for(j=IDELEMS(gls)-1;j>=0;j--)
4517  {
4518  if (gls->m[j]!=NULL)
4519  {
4520  test_id->m[0]=gls->m[j];
4521  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4522  if (dummy_w!=NULL)
4523  {
4524  WerrorS("Newton polytope not of expected dimension");
4525  delete dummy_w;
4526  return TRUE;
4527  }
4528  }
4529  }
4530  }
4531 
4532  // get and set precision in digits ( > 0 )
4533  if ( v->Typ() != INT_CMD )
4534  return TRUE;
4535  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4537  {
4538  unsigned long int ii=(unsigned long int)v->Data();
4539  setGMPFloatDigits( ii, ii );
4540  }
4541  v= v->next;
4542 
4543  // get interpolation steps (0,1,2)
4544  if ( v->Typ() != INT_CMD )
4545  return TRUE;
4546  else howclean= (int)(long)v->Data();
4547 
4548  uResultant::resMatType mtype= determineMType( imtype );
4549  int i,count;
4550  lists listofroots= NULL;
4551  number smv= NULL;
4552  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4553 
4554  //emptylist= (lists)omAlloc( sizeof(slists) );
4555  //emptylist->Init( 0 );
4556 
4557  //res->rtyp = LIST_CMD;
4558  //res->data= (void *)emptylist;
4559 
4560  // check input ideal ( = polynomial system )
4561  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4562  {
4563  return TRUE;
4564  }
4565 
4566  uResultant * ures;
4567  rootContainer ** iproots;
4568  rootContainer ** muiproots;
4569  rootArranger * arranger;
4570 
4571  // main task 1: setup of resultant matrix
4572  ures= new uResultant( gls, mtype );
4573  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4574  {
4575  WerrorS("Error occurred during matrix setup!");
4576  return TRUE;
4577  }
4578 
4579  // if dense resultant, check if minor nonsingular
4580  if ( mtype == uResultant::denseResMat )
4581  {
4582  smv= ures->accessResMat()->getSubDet();
4583 #ifdef mprDEBUG_PROT
4584  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4585 #endif
4586  if ( nIsZero(smv) )
4587  {
4588  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4589  return TRUE;
4590  }
4591  }
4592 
4593  // main task 2: Interpolate specialized resultant polynomials
4594  if ( interpolate_det )
4595  iproots= ures->interpolateDenseSP( false, smv );
4596  else
4597  iproots= ures->specializeInU( false, smv );
4598 
4599  // main task 3: Interpolate specialized resultant polynomials
4600  if ( interpolate_det )
4601  muiproots= ures->interpolateDenseSP( true, smv );
4602  else
4603  muiproots= ures->specializeInU( true, smv );
4604 
4605 #ifdef mprDEBUG_PROT
4606  int c= iproots[0]->getAnzElems();
4607  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4608  c= muiproots[0]->getAnzElems();
4609  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4610 #endif
4611 
4612  // main task 4: Compute roots of specialized polys and match them up
4613  arranger= new rootArranger( iproots, muiproots, howclean );
4614  arranger->solve_all();
4615 
4616  // get list of roots
4617  if ( arranger->success() )
4618  {
4619  arranger->arrange();
4620  listofroots= listOfRoots(arranger, gmp_output_digits );
4621  }
4622  else
4623  {
4624  WerrorS("Solver was unable to find any roots!");
4625  return TRUE;
4626  }
4627 
4628  // free everything
4629  count= iproots[0]->getAnzElems();
4630  for (i=0; i < count; i++) delete iproots[i];
4631  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4632  count= muiproots[0]->getAnzElems();
4633  for (i=0; i < count; i++) delete muiproots[i];
4634  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4635 
4636  delete ures;
4637  delete arranger;
4638  nDelete( &smv );
4639 
4640  res->data= (void *)listofroots;
4641 
4642  //emptylist->Clean();
4643  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4644 
4645  return FALSE;
4646 }
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:322
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)
Definition: mpr_inout.cc:135
void * ADDRESS
Definition: auxiliary.h:161
void pWrite(poly p)
Definition: polys.h:279
void WerrorS(const char *s)
Definition: feFopen.cc:23
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:955
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)
Definition: mpr_inout.cc:94
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:1097
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:4649
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 4391 of file ipshell.cc.

4392 {
4393  int i;
4394  ideal p,w;
4395  p= (ideal)arg1->Data();
4396  w= (ideal)arg2->Data();
4397 
4398  // w[0] = f(p^0)
4399  // w[1] = f(p^1)
4400  // ...
4401  // p can be a vector of numbers (multivariate polynom)
4402  // or one number (univariate polynom)
4403  // tdg = deg(f)
4404 
4405  int n= IDELEMS( p );
4406  int m= IDELEMS( w );
4407  int tdg= (int)(long)arg3->Data();
4408 
4409  res->data= (void*)NULL;
4410 
4411  // check the input
4412  if ( tdg < 1 )
4413  {
4414  WerrorS("Last input parameter must be > 0!");
4415  return TRUE;
4416  }
4417  if ( n != rVar(currRing) )
4418  {
4419  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4420  return TRUE;
4421  }
4422  if ( m != (int)pow((double)tdg+1,(double)n) )
4423  {
4424  Werror("Size of second input ideal must be equal to %d!",
4425  (int)pow((double)tdg+1,(double)n));
4426  return TRUE;
4427  }
4428  if ( !(rField_is_Q(currRing) /* ||
4429  rField_is_R() || rField_is_long_R() ||
4430  rField_is_long_C()*/ ) )
4431  {
4432  WerrorS("Ground field not implemented!");
4433  return TRUE;
4434  }
4435 
4436  number tmp;
4437  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4438  for ( i= 0; i < n; i++ )
4439  {
4440  pevpoint[i]=nInit(0);
4441  if ( (p->m)[i] )
4442  {
4443  tmp = pGetCoeff( (p->m)[i] );
4444  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4445  {
4446  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4447  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4448  return TRUE;
4449  }
4450  } else tmp= NULL;
4451  if ( !nIsZero(tmp) )
4452  {
4453  if ( !pIsConstant((p->m)[i]))
4454  {
4455  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4456  WerrorS("Elements of first input ideal must be numbers!");
4457  return TRUE;
4458  }
4459  pevpoint[i]= nCopy( tmp );
4460  }
4461  }
4462 
4463  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4464  for ( i= 0; i < m; i++ )
4465  {
4466  wresults[i]= nInit(0);
4467  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4468  {
4469  if ( !pIsConstant((w->m)[i]))
4470  {
4471  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4472  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4473  WerrorS("Elements of second input ideal must be numbers!");
4474  return TRUE;
4475  }
4476  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4477  }
4478  }
4479 
4480  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4481  number *ncpoly= vm.interpolateDense( wresults );
4482  // do not free ncpoly[]!!
4483  poly rpoly= vm.numvec2poly( ncpoly );
4484 
4485  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4486  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4487 
4488  res->data= (void*)rpoly;
4489  return FALSE;
4490 }
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
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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:23
#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:1097
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 5894 of file ipshell.cc.

5895 {
5896  Print(" %s (",n);
5897  switch (p->language)
5898  {
5899  case LANG_SINGULAR: PrintS("S"); break;
5900  case LANG_C: PrintS("C"); break;
5901  case LANG_TOP: PrintS("T"); break;
5902  case LANG_NONE: PrintS("N"); break;
5903  default: PrintS("U");
5904  }
5905  if(p->libname!=NULL)
5906  Print(",%s", p->libname);
5907  PrintS(")");
5908 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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 2130 of file ipshell.cc.

2131 {
2132  if ((L->nr!=3)
2133 #ifdef HAVE_PLURAL
2134  &&(L->nr!=5)
2135 #endif
2136  )
2137  return NULL;
2138  int is_gf_char=0;
2139  // 0: char/ cf - ring
2140  // 1: list (var)
2141  // 2: list (ord)
2142  // 3: qideal
2143  // possibly:
2144  // 4: C
2145  // 5: D
2146 
2147  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2148 
2149 
2150  // ------------------------------------------------------------------
2151  // 0: char:
2152 #ifdef SINGULAR_4_1
2153  if (L->m[0].Typ()==CRING_CMD)
2154  {
2155  R->cf=(coeffs)L->m[0].Data();
2156  R->cf->ref++;
2157  }
2158  else
2159 #endif
2160  if (L->m[0].Typ()==INT_CMD)
2161  {
2162  int ch = (int)(long)L->m[0].Data();
2163  assume( ch >= 0 );
2164 
2165  if (ch == 0) // Q?
2166  R->cf = nInitChar(n_Q, NULL);
2167  else
2168  {
2169  int l = IsPrime(ch); // Zp?
2170  if( l != ch )
2171  {
2172  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2173  ch = l;
2174  }
2175  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2176  }
2177  }
2178  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2179  {
2180  lists LL=(lists)L->m[0].Data();
2181 
2182 #ifdef HAVE_RINGS
2183  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2184  {
2185  rComposeRing(LL, R); // Ring!?
2186  }
2187  else
2188 #endif
2189  if (LL->nr < 3)
2190  rComposeC(LL,R); // R, long_R, long_C
2191  else
2192  {
2193  if (LL->m[0].Typ()==INT_CMD)
2194  {
2195  int ch = (int)(long)LL->m[0].Data();
2196  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2197  if (fftable[is_gf_char]==0) is_gf_char=-1;
2198 
2199  if(is_gf_char!= -1)
2200  {
2201  GFInfo param;
2202 
2203  param.GFChar = ch;
2204  param.GFDegree = 1;
2205  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2206 
2207  // nfInitChar should be able to handle the case when ch is in fftables!
2208  R->cf = nInitChar(n_GF, (void*)&param);
2209  }
2210  }
2211 
2212  if( R->cf == NULL )
2213  {
2214  ring extRing = rCompose((lists)L->m[0].Data(),FALSE);
2215 
2216  if (extRing==NULL)
2217  {
2218  WerrorS("could not create the specified coefficient field");
2219  goto rCompose_err;
2220  }
2221 
2222  if( extRing->qideal != NULL ) // Algebraic extension
2223  {
2224  AlgExtInfo extParam;
2225 
2226  extParam.r = extRing;
2227 
2228  R->cf = nInitChar(n_algExt, (void*)&extParam);
2229  }
2230  else // Transcendental extension
2231  {
2232  TransExtInfo extParam;
2233  extParam.r = extRing;
2234  assume( extRing->qideal == NULL );
2235 
2236  R->cf = nInitChar(n_transExt, &extParam);
2237  }
2238  }
2239  }
2240  }
2241  else
2242  {
2243  WerrorS("coefficient field must be described by `int` or `list`");
2244  goto rCompose_err;
2245  }
2246 
2247  if( R->cf == NULL )
2248  {
2249  WerrorS("could not create coefficient field described by the input!");
2250  goto rCompose_err;
2251  }
2252 
2253  // ------------------------- VARS ---------------------------
2254  if (L->m[1].Typ()==LIST_CMD)
2255  {
2256  lists v=(lists)L->m[1].Data();
2257  R->N = v->nr+1;
2258  if (R->N<=0)
2259  {
2260  WerrorS("no ring variables");
2261  goto rCompose_err;
2262  }
2263  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2264  int i;
2265  for(i=0;i<R->N;i++)
2266  {
2267  if (v->m[i].Typ()==STRING_CMD)
2268  R->names[i]=omStrDup((char *)v->m[i].Data());
2269  else if (v->m[i].Typ()==POLY_CMD)
2270  {
2271  poly p=(poly)v->m[i].Data();
2272  int nr=pIsPurePower(p);
2273  if (nr>0)
2274  R->names[i]=omStrDup(currRing->names[nr-1]);
2275  else
2276  {
2277  Werror("var name %d must be a string or a ring variable",i+1);
2278  goto rCompose_err;
2279  }
2280  }
2281  else
2282  {
2283  Werror("var name %d must be `string`",i+1);
2284  goto rCompose_err;
2285  }
2286  }
2287  }
2288  else
2289  {
2290  WerrorS("variable must be given as `list`");
2291  goto rCompose_err;
2292  }
2293  // ------------------------ ORDER ------------------------------
2294  if (L->m[2].Typ()==LIST_CMD)
2295  {
2296  lists v=(lists)L->m[2].Data();
2297  int n= v->nr+2;
2298  int j;
2299  // initialize fields of R
2300  R->order=(int *)omAlloc0(n*sizeof(int));
2301  R->block0=(int *)omAlloc0(n*sizeof(int));
2302  R->block1=(int *)omAlloc0(n*sizeof(int));
2303  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
2304  // init order, so that rBlocks works correctly
2305  for (j=0; j < n-1; j++)
2306  R->order[j] = (int) ringorder_unspec;
2307  // orderings
2308  for(j=0;j<n-1;j++)
2309  {
2310  // todo: a(..), M
2311  if (v->m[j].Typ()!=LIST_CMD)
2312  {
2313  WerrorS("ordering must be list of lists");
2314  goto rCompose_err;
2315  }
2316  lists vv=(lists)v->m[j].Data();
2317  if ((vv->nr!=1)
2318  || (vv->m[0].Typ()!=STRING_CMD)
2319  || ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD)))
2320  {
2321  WerrorS("ordering name must be a (string,intvec)");
2322  goto rCompose_err;
2323  }
2324  R->order[j]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2325 
2326  if (j==0) R->block0[0]=1;
2327  else
2328  {
2329  int jj=j-1;
2330  while((jj>=0)
2331  && ((R->order[jj]== ringorder_a)
2332  || (R->order[jj]== ringorder_aa)
2333  || (R->order[jj]== ringorder_am)
2334  || (R->order[jj]== ringorder_c)
2335  || (R->order[jj]== ringorder_C)
2336  || (R->order[jj]== ringorder_s)
2337  || (R->order[jj]== ringorder_S)
2338  ))
2339  {
2340  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2341  jj--;
2342  }
2343  if (jj<0) R->block0[j]=1;
2344  else R->block0[j]=R->block1[jj]+1;
2345  }
2346  intvec *iv;
2347  if (vv->m[1].Typ()==INT_CMD)
2348  iv=new intvec((int)(long)vv->m[1].Data(),(int)(long)vv->m[1].Data());
2349  else
2350  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC
2351  int iv_len=iv->length();
2352  R->block1[j]=si_max(R->block0[j],R->block0[j]+iv_len-1);
2353  if (R->block1[j]>R->N)
2354  {
2355  R->block1[j]=R->N;
2356  iv_len=R->block1[j]-R->block0[j]+1;
2357  }
2358  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2359  int i;
2360  switch (R->order[j])
2361  {
2362  case ringorder_ws:
2363  case ringorder_Ws:
2364  R->OrdSgn=-1;
2365  case ringorder_aa:
2366  case ringorder_a:
2367  case ringorder_wp:
2368  case ringorder_Wp:
2369  R->wvhdl[j] =( int *)omAlloc(iv_len*sizeof(int));
2370  for (i=0; i<iv_len;i++)
2371  {
2372  R->wvhdl[j][i]=(*iv)[i];
2373  }
2374  break;
2375  case ringorder_am:
2376  R->wvhdl[j] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2377  for (i=0; i<iv_len;i++)
2378  {
2379  R->wvhdl[j][i]=(*iv)[i];
2380  }
2381  R->wvhdl[j][i]=iv->length() - iv_len;
2382  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2383  for (; i<iv->length(); i++)
2384  {
2385  R->wvhdl[j][i+1]=(*iv)[i];
2386  }
2387  break;
2388  case ringorder_M:
2389  R->wvhdl[j] =( int *)omAlloc((iv->length())*sizeof(int));
2390  for (i=0; i<iv->length();i++) R->wvhdl[j][i]=(*iv)[i];
2391  R->block1[j]=si_max(R->block0[j],R->block0[j]+(int)sqrt((double)(iv->length()-1)));
2392  if (R->block1[j]>R->N)
2393  {
2394  WerrorS("ordering matrix too big");
2395  goto rCompose_err;
2396  }
2397  break;
2398  case ringorder_ls:
2399  case ringorder_ds:
2400  case ringorder_Ds:
2401  case ringorder_rs:
2402  R->OrdSgn=-1;
2403  case ringorder_lp:
2404  case ringorder_dp:
2405  case ringorder_Dp:
2406  case ringorder_rp:
2407  break;
2408  case ringorder_S:
2409  break;
2410  case ringorder_c:
2411  case ringorder_C:
2412  R->block1[j]=R->block0[j]=0;
2413  break;
2414 
2415  case ringorder_s:
2416  break;
2417 
2418  case ringorder_IS:
2419  {
2420  R->block1[j] = R->block0[j] = 0;
2421  if( iv->length() > 0 )
2422  {
2423  const int s = (*iv)[0];
2424  assume( -2 < s && s < 2 );
2425  R->block1[j] = R->block0[j] = s;
2426  }
2427  break;
2428  }
2429  case 0:
2430  case ringorder_unspec:
2431  break;
2432  }
2433  delete iv;
2434  }
2435  // sanity check
2436  j=n-2;
2437  if ((R->order[j]==ringorder_c)
2438  || (R->order[j]==ringorder_C)
2439  || (R->order[j]==ringorder_unspec)) j--;
2440  if (R->block1[j] != R->N)
2441  {
2442  if (((R->order[j]==ringorder_dp) ||
2443  (R->order[j]==ringorder_ds) ||
2444  (R->order[j]==ringorder_Dp) ||
2445  (R->order[j]==ringorder_Ds) ||
2446  (R->order[j]==ringorder_rp) ||
2447  (R->order[j]==ringorder_rs) ||
2448  (R->order[j]==ringorder_lp) ||
2449  (R->order[j]==ringorder_ls))
2450  &&
2451  R->block0[j] <= R->N)
2452  {
2453  R->block1[j] = R->N;
2454  }
2455  else
2456  {
2457  Werror("ordering incomplete: size (%d) should be %d",R->block1[j],R->N);
2458  goto rCompose_err;
2459  }
2460  }
2461  if (R->block0[j]>R->N)
2462  {
2463  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j+1);
2464  for(int ii=0;ii<=j;ii++)
2465  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2466  goto rCompose_err;
2467  }
2468  if (check_comp)
2469  {
2470  BOOLEAN comp_order=FALSE;
2471  int jj;
2472  for(jj=0;jj<n;jj++)
2473  {
2474  if ((R->order[jj]==ringorder_c) ||
2475  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2476  }
2477  if (!comp_order)
2478  {
2479  R->order=(int*)omRealloc0Size(R->order,n*sizeof(int),(n+1)*sizeof(int));
2480  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2481  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2482  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2483  R->order[n-1]=ringorder_C;
2484  R->block0[n-1]=0;
2485  R->block1[n-1]=0;
2486  R->wvhdl[n-1]=NULL;
2487  n++;
2488  }
2489  }
2490  }
2491  else
2492  {
2493  WerrorS("ordering must be given as `list`");
2494  goto rCompose_err;
2495  }
2496 
2497  // ------------------------ ??????? --------------------
2498 
2499  rRenameVars(R);
2500  rComplete(R);
2501 
2502 /*#ifdef HAVE_RINGS
2503 // currently, coefficients which are ring elements require a global ordering:
2504  if (rField_is_Ring(R) && (R->OrdSgn==-1))
2505  {
2506  WerrorS("global ordering required for these coefficients");
2507  goto rCompose_err;
2508  }
2509 #endif*/
2510 
2511 
2512  // ------------------------ Q-IDEAL ------------------------
2513 
2514  if (L->m[3].Typ()==IDEAL_CMD)
2515  {
2516  ideal q=(ideal)L->m[3].Data();
2517  if (q->m[0]!=NULL)
2518  {
2519  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2520  {
2521  #if 0
2522  WerrorS("coefficient fields must be equal if q-ideal !=0");
2523  goto rCompose_err;
2524  #else
2525  ring orig_ring=currRing;
2526  rChangeCurrRing(R);
2527  int *perm=NULL;
2528  int *par_perm=NULL;
2529  int par_perm_size=0;
2530  nMapFunc nMap;
2531 
2532  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2533  {
2534  if (rEqual(orig_ring,currRing))
2535  {
2536  nMap=n_SetMap(currRing->cf, currRing->cf);
2537  }
2538  else
2539  // Allow imap/fetch to be make an exception only for:
2540  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2543  ||
2544  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2545  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2546  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2547  {
2548  par_perm_size=rPar(orig_ring);
2549 
2550 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2551 // naSetChar(rInternalChar(orig_ring),orig_ring);
2552 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2553 
2554  nSetChar(currRing->cf);
2555  }
2556  else
2557  {
2558  WerrorS("coefficient fields must be equal if q-ideal !=0");
2559  goto rCompose_err;
2560  }
2561  }
2562  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2563  if (par_perm_size!=0)
2564  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2565  int i;
2566  #if 0
2567  // use imap:
2568  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2569  currRing->names,currRing->N,currRing->parameter, currRing->P,
2570  perm,par_perm, currRing->ch);
2571  #else
2572  // use fetch
2573  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2574  {
2575  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2576  }
2577  else if (par_perm_size!=0)
2578  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2579  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2580  #endif
2581  ideal dest_id=idInit(IDELEMS(q),1);
2582  for(i=IDELEMS(q)-1; i>=0; i--)
2583  {
2584  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2585  par_perm,par_perm_size);
2586  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2587  pTest(dest_id->m[i]);
2588  }
2589  R->qideal=dest_id;
2590  if (perm!=NULL)
2591  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2592  if (par_perm!=NULL)
2593  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2594  rChangeCurrRing(orig_ring);
2595  #endif
2596  }
2597  else
2598  R->qideal=idrCopyR(q,currRing,R);
2599  }
2600  }
2601  else
2602  {
2603  WerrorS("q-ideal must be given as `ideal`");
2604  goto rCompose_err;
2605  }
2606 
2607 
2608  // ---------------------------------------------------------------
2609  #ifdef HAVE_PLURAL
2610  if (L->nr==5)
2611  {
2612  if (nc_CallPlural((matrix)L->m[4].Data(),
2613  (matrix)L->m[5].Data(),
2614  NULL,NULL,
2615  R,
2616  true, // !!!
2617  true, false,
2618  currRing, FALSE)) goto rCompose_err;
2619  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
2620  }
2621  #endif
2622  return R;
2623 
2624 rCompose_err:
2625  if (R->N>0)
2626  {
2627  int i;
2628  if (R->names!=NULL)
2629  {
2630  i=R->N-1;
2631  while (i>=0) { if (R->names[i]!=NULL) omFree(R->names[i]); i--; }
2632  omFree(R->names);
2633  }
2634  }
2635  if (R->order!=NULL) omFree(R->order);
2636  if (R->block0!=NULL) omFree(R->block0);
2637  if (R->block1!=NULL) omFree(R->block1);
2638  if (R->wvhdl!=NULL) omFree(R->wvhdl);
2639  omFree(R);
2640  return NULL;
2641 }
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:2130
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
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
intvec * ivCopy(const intvec *o)
Definition: intvec.h:137
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:23
int Typ()
Definition: subexpr.cc:955
#define omAlloc(size)
Definition: omAllocDecl.h:210
void rComposeC(lists L, ring R)
Definition: ipshell.cc:1937
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:3435
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 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:2089
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:3928
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:1996
#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
#define R
Definition: sirandom.c:26
void * Data()
Definition: subexpr.cc:1097
#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 perm[100]
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 1937 of file ipshell.cc.

1939 {
1940  // ----------------------------------------
1941  // 0: char/ cf - ring
1942  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
1943  {
1944  Werror("invald coeff. field description, expecting 0");
1945  return;
1946  }
1947 // R->cf->ch=0;
1948  // ----------------------------------------
1949  // 1:
1950  if (L->m[1].rtyp!=LIST_CMD)
1951  Werror("invald coeff. field description, expecting precision list");
1952  lists LL=(lists)L->m[1].data;
1953  int r1=(int)(long)LL->m[0].data;
1954  int r2=(int)(long)LL->m[1].data;
1955  if (L->nr==2) // complex
1956  R->cf = nInitChar(n_long_C, NULL);
1957  else if ((r1<=SHORT_REAL_LENGTH)
1958  && (r2=SHORT_REAL_LENGTH))
1959  R->cf = nInitChar(n_R, NULL);
1960  else
1961  {
1963  p->float_len=r1;
1964  p->float_len2=r2;
1965  R->cf = nInitChar(n_long_R, NULL);
1966  }
1967 
1968  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
1969  && (r2=SHORT_REAL_LENGTH))
1970  {
1971  R->cf->float_len=SHORT_REAL_LENGTH/2;
1972  R->cf->float_len2=SHORT_REAL_LENGTH;
1973  }
1974  else
1975  {
1976  R->cf->float_len=si_min(r1,32767);
1977  R->cf->float_len2=si_min(r2,32767);
1978  }
1979  // ----------------------------------------
1980  // 2: list (par)
1981  if (L->nr==2)
1982  {
1983  //R->cf->extRing->N=1;
1984  if (L->m[2].rtyp!=STRING_CMD)
1985  {
1986  Werror("invald coeff. field description, expecting parameter name");
1987  return;
1988  }
1989  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
1990  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
1991  }
1992  // ----------------------------------------
1993 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
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
int int kStrategy strat if(h==NULL) return NULL
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
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
#define R
Definition: sirandom.c:26
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 1996 of file ipshell.cc.

1998 {
1999  // ----------------------------------------
2000  // 0: string: integer
2001  // no further entries --> Z
2002  mpz_ptr modBase = NULL;
2003  unsigned int modExponent = 1;
2004 
2005  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
2006  if (L->nr == 0)
2007  {
2008  mpz_init_set_ui(modBase,0);
2009  modExponent = 1;
2010  }
2011  // ----------------------------------------
2012  // 1:
2013  else
2014  {
2015  if (L->m[1].rtyp!=LIST_CMD) Werror("invald data, expecting list of numbers");
2016  lists LL=(lists)L->m[1].data;
2017  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2018  {
2019  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2020  // assume that tmp is integer, not rational
2021  n_MPZ (modBase, tmp, coeffs_BIGINT);
2022  }
2023  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2024  {
2025  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2026  }
2027  else
2028  {
2029  mpz_init_set_ui(modBase,0);
2030  }
2031  if (LL->nr >= 1)
2032  {
2033  modExponent = (unsigned long) LL->m[1].data;
2034  }
2035  else
2036  {
2037  modExponent = 1;
2038  }
2039  }
2040  // ----------------------------------------
2041  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2042  {
2043  Werror("Wrong ground ring specification (module is 1)");
2044  return;
2045  }
2046  if (modExponent < 1)
2047  {
2048  Werror("Wrong ground ring specification (exponent smaller than 1");
2049  return;
2050  }
2051  // module is 0 ---> integers
2052  if (mpz_cmp_ui(modBase, 0) == 0)
2053  {
2054  R->cf=nInitChar(n_Z,NULL);
2055  }
2056  // we have an exponent
2057  else if (modExponent > 1)
2058  {
2059  //R->cf->ch = R->cf->modExponent;
2060  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2061  {
2062  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2063  depending on the size of a long on the respective platform */
2064  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2065  omFreeSize (modBase, sizeof(mpz_t));
2066  }
2067  else
2068  {
2069  //ringtype 3
2070  ZnmInfo info;
2071  info.base= modBase;
2072  info.exp= modExponent;
2073  R->cf=nInitChar(n_Znm,(void*) &info);
2074  }
2075  }
2076  // just a module m > 1
2077  else
2078  {
2079  //ringtype = 2;
2080  //const int ch = mpz_get_ui(modBase);
2081  ZnmInfo info;
2082  info.base= modBase;
2083  info.exp= modExponent;
2084  R->cf=nInitChar(n_Zn,(void*) &info);
2085  }
2086 }
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
Definition: tok.h:42
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
coeffs coeffs_BIGINT
Definition: ipid.cc:53
#define omAlloc(size)
Definition: omAllocDecl.h:210
int int kStrategy strat if(h==NULL) return NULL
void * data
Definition: subexpr.h:89
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:44
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:42
unsigned long exp
Definition: rmodulon.h:18
#define info
Definition: libparse.cc:1254
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
#define R
Definition: sirandom.c:26
int rtyp
Definition: subexpr.h: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 1744 of file ipshell.cc.

1745 {
1746  assume( r != NULL );
1747  const coeffs C = r->cf;
1748  assume( C != NULL );
1749 
1750  // sanity check: require currRing==r for rings with polynomial data
1751  if ( (r!=currRing) && (
1752  (nCoeff_is_algExt(C) && (C != currRing->cf))
1753  || (r->qideal != NULL)
1754 #ifdef HAVE_PLURAL
1755  || (rIsPluralRing(r))
1756 #endif
1757  )
1758  )
1759  {
1760  WerrorS("ring with polynomial data must be the base ring or compatible");
1761  return NULL;
1762  }
1763  // 0: char/ cf - ring
1764  // 1: list (var)
1765  // 2: list (ord)
1766  // 3: qideal
1767  // possibly:
1768  // 4: C
1769  // 5: D
1771  if (rIsPluralRing(r))
1772  L->Init(6);
1773  else
1774  L->Init(4);
1775  // ----------------------------------------
1776  // 0: char/ cf - ring
1777 #ifdef SINGULAR_4_1
1778  // 0: char/ cf - ring
1779  L->m[0].rtyp=CRING_CMD;
1780  L->m[0].data=(char*)r->cf; r->cf->ref++;
1781 #else
1783  {
1784  rDecomposeC(&(L->m[0]),r);
1785  }
1786 #ifdef HAVE_RINGS
1787  else if (rField_is_Ring(r))
1788  {
1789  rDecomposeRing(&(L->m[0]),r);
1790  }
1791 #endif
1792  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1793  {
1794  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
1795  }
1796  else if(rField_is_GF(r))
1797  {
1799  Lc->Init(4);
1800  // char:
1801  Lc->m[0].rtyp=INT_CMD;
1802  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
1803  // var:
1805  Lv->Init(1);
1806  Lv->m[0].rtyp=STRING_CMD;
1807  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
1808  Lc->m[1].rtyp=LIST_CMD;
1809  Lc->m[1].data=(void*)Lv;
1810  // ord:
1812  Lo->Init(1);
1814  Loo->Init(2);
1815  Loo->m[0].rtyp=STRING_CMD;
1816  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1817 
1818  intvec *iv=new intvec(1); (*iv)[0]=1;
1819  Loo->m[1].rtyp=INTVEC_CMD;
1820  Loo->m[1].data=(void *)iv;
1821 
1822  Lo->m[0].rtyp=LIST_CMD;
1823  Lo->m[0].data=(void*)Loo;
1824 
1825  Lc->m[2].rtyp=LIST_CMD;
1826  Lc->m[2].data=(void*)Lo;
1827  // q-ideal:
1828  Lc->m[3].rtyp=IDEAL_CMD;
1829  Lc->m[3].data=(void *)idInit(1,1);
1830  // ----------------------
1831  L->m[0].rtyp=LIST_CMD;
1832  L->m[0].data=(void*)Lc;
1833  }
1834  else
1835  {
1836  L->m[0].rtyp=INT_CMD;
1837  L->m[0].data=(void *)(long)r->cf->ch;
1838  }
1839 #endif
1840  // ----------------------------------------
1841  // 1: list (var)
1843  LL->Init(r->N);
1844  int i;
1845  for(i=0; i<r->N; i++)
1846  {
1847  LL->m[i].rtyp=STRING_CMD;
1848  LL->m[i].data=(void *)omStrDup(r->names[i]);
1849  }
1850  L->m[1].rtyp=LIST_CMD;
1851  L->m[1].data=(void *)LL;
1852  // ----------------------------------------
1853  // 2: list (ord)
1855  i=rBlocks(r)-1;
1856  LL->Init(i);
1857  i--;
1858  lists LLL;
1859  for(; i>=0; i--)
1860  {
1861  intvec *iv;
1862  int j;
1863  LL->m[i].rtyp=LIST_CMD;
1865  LLL->Init(2);
1866  LLL->m[0].rtyp=STRING_CMD;
1867  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1868 
1869  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1870  {
1871  assume( r->block0[i] == r->block1[i] );
1872  const int s = r->block0[i];
1873  assume( -2 < s && s < 2);
1874 
1875  iv=new intvec(1);
1876  (*iv)[0] = s;
1877  }
1878  else if (r->block1[i]-r->block0[i] >=0 )
1879  {
1880  int bl=j=r->block1[i]-r->block0[i];
1881  if (r->order[i]==ringorder_M)
1882  {
1883  j=(j+1)*(j+1)-1;
1884  bl=j+1;
1885  }
1886  else if (r->order[i]==ringorder_am)
1887  {
1888  j+=r->wvhdl[i][bl+1];
1889  }
1890  iv=new intvec(j+1);
1891  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1892  {
1893  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1894  }
1895  else switch (r->order[i])
1896  {
1897  case ringorder_dp:
1898  case ringorder_Dp:
1899  case ringorder_ds:
1900  case ringorder_Ds:
1901  case ringorder_lp:
1902  for(;j>=0; j--) (*iv)[j]=1;
1903  break;
1904  default: /* do nothing */;
1905  }
1906  }
1907  else
1908  {
1909  iv=new intvec(1);
1910  }
1911  LLL->m[1].rtyp=INTVEC_CMD;
1912  LLL->m[1].data=(void *)iv;
1913  LL->m[i].data=(void *)LLL;
1914  }
1915  L->m[2].rtyp=LIST_CMD;
1916  L->m[2].data=(void *)LL;
1917  // ----------------------------------------
1918  // 3: qideal
1919  L->m[3].rtyp=IDEAL_CMD;
1920  if (r->qideal==NULL)
1921  L->m[3].data=(void *)idInit(1,1);
1922  else
1923  L->m[3].data=(void *)idCopy(r->qideal);
1924  // ----------------------------------------
1925 #ifdef HAVE_PLURAL // NC! in rDecompose
1926  if (rIsPluralRing(r))
1927  {
1928  L->m[4].rtyp=MATRIX_CMD;
1929  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
1930  L->m[5].rtyp=MATRIX_CMD;
1931  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
1932  }
1933 #endif
1934  return L;
1935 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1679
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:23
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:470
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:573
CanonicalForm Lc(const CanonicalForm &f)
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
int int kStrategy strat if(h==NULL) return NULL
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1591
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:76
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
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1715
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:437
#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
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:464
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rDecomposeC ( leftv  h,
const ring  R 
)

Definition at line 1679 of file ipshell.cc.

1681 {
1683  if (rField_is_long_C(R)) L->Init(3);
1684  else L->Init(2);
1685  h->rtyp=LIST_CMD;
1686  h->data=(void *)L;
1687  // 0: char/ cf - ring
1688  // 1: list (var)
1689  // 2: list (ord)
1690  // ----------------------------------------
1691  // 0: char/ cf - ring
1692  L->m[0].rtyp=INT_CMD;
1693  L->m[0].data=(void *)0;
1694  // ----------------------------------------
1695  // 1:
1697  LL->Init(2);
1698  LL->m[0].rtyp=INT_CMD;
1699  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1700  LL->m[1].rtyp=INT_CMD;
1701  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1702  L->m[1].rtyp=LIST_CMD;
1703  L->m[1].data=(void *)LL;
1704  // ----------------------------------------
1705  // 2: list (par)
1706  if (rField_is_long_C(R))
1707  {
1708  L->m[2].rtyp=STRING_CMD;
1709  L->m[2].data=(void *)omStrDup(*rParameter(R));
1710  }
1711  // ----------------------------------------
1712 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:573
void * data
Definition: subexpr.h:89
static int si_max(const int a, const int b)
Definition: auxiliary.h:166
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 omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
#define R
Definition: sirandom.c:26
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 1591 of file ipshell.cc.

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

Definition at line 1715 of file ipshell.cc.

1717 {
1719  if (rField_is_Ring_Z(R)) L->Init(1);
1720  else L->Init(2);
1721  h->rtyp=LIST_CMD;
1722  h->data=(void *)L;
1723  // 0: char/ cf - ring
1724  // 1: list (module)
1725  // ----------------------------------------
1726  // 0: char/ cf - ring
1727  L->m[0].rtyp=STRING_CMD;
1728  L->m[0].data=(void *)omStrDup("integer");
1729  // ----------------------------------------
1730  // 1: module
1731  if (rField_is_Ring_Z(R)) return;
1733  LL->Init(2);
1734  LL->m[0].rtyp=BIGINT_CMD;
1735  LL->m[0].data=nlMapGMP((number) R->cf->modBase, R->cf, R->cf); // TODO: what is this?? // extern number nlMapGMP(number from, const coeffs src, const coeffs dst); // FIXME: replace with n_InitMPZ(R->cf->modBase, coeffs_BIGINT); ?
1736  LL->m[1].rtyp=INT_CMD;
1737  LL->m[1].data=(void *) R->cf->modExponent;
1738  L->m[1].rtyp=LIST_CMD;
1739  L->m[1].data=(void *)LL;
1740 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:85
Definition: lists.h:22
Definition: tok.h:42
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
#define R
Definition: sirandom.c:26
static BOOLEAN rField_is_Ring_Z(const ring r)
Definition: ring.h:434
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 1520 of file ipshell.cc.

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

1566 {
1568  if (h!=NULL) return h;
1569  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1570  if (h!=NULL) return h;
1572  while(p!=NULL)
1573  {
1574  if ((p->cPack!=basePack)
1575  && (p->cPack!=currPack))
1576  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1577  if (h!=NULL) return h;
1578  p=p->next;
1579  }
1580  idhdl tmp=basePack->idroot;
1581  while (tmp!=NULL)
1582  {
1583  if (IDTYP(tmp)==PACKAGE_CMD)
1584  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1585  if (h!=NULL) return h;
1586  tmp=IDNEXT(tmp);
1587  }
1588  return NULL;
1589 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:5778
return P p
Definition: myNF.cc:203
#define IDNEXT(a)
Definition: ipid.h:117
proclevel * procstack
Definition: ipid.cc:57
#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:63
package currPack
Definition: ipid.cc:62
static Poly * h
Definition: janet.cc:978
package cPack
Definition: ipid.h:63
ring rInit ( sleftv pn,
sleftv rv,
sleftv ord 
)

Definition at line 5179 of file ipshell.cc.

5180 {
5181 #ifdef HAVE_RINGS
5182  //unsigned int ringtype = 0;
5183  mpz_ptr modBase = NULL;
5184  unsigned int modExponent = 1;
5185 #endif
5186  int float_len=0;
5187  int float_len2=0;
5188  ring R = NULL;
5189  //BOOLEAN ffChar=FALSE;
5190 
5191  /* ch -------------------------------------------------------*/
5192  // get ch of ground field
5193 
5194  // allocated ring
5195  R = (ring) omAlloc0Bin(sip_sring_bin);
5196 
5197  coeffs cf = NULL;
5198 
5199  assume( pn != NULL );
5200  const int P = pn->listLength();
5201 
5202  if ((pn->Typ()==CRING_CMD)&&(P==1))
5203  {
5204  cf=(coeffs)pn->CopyD();
5205  assume( cf != NULL );
5206  }
5207  else if (pn->Typ()==INT_CMD)
5208  {
5209  int ch = (int)(long)pn->Data();
5210 
5211  /* parameter? -------------------------------------------------------*/
5212  pn = pn->next;
5213 
5214  if (pn == NULL) // no params!?
5215  {
5216  if (ch!=0)
5217  {
5218  int ch2=IsPrime(ch);
5219  if ((ch<2)||(ch!=ch2))
5220  {
5221  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5222  ch=32003;
5223  }
5224  cf = nInitChar(n_Zp, (void*)(long)ch);
5225  }
5226  else
5227  cf = nInitChar(n_Q, (void*)(long)ch);
5228  }
5229  else
5230  {
5231  const int pars = pn->listLength();
5232 
5233  assume( pars > 0 );
5234 
5235  // predefined finite field: (p^k, a)
5236  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5237  {
5238  GFInfo param;
5239 
5240  param.GFChar = ch;
5241  param.GFDegree = 1;
5242  param.GFPar_name = pn->name;
5243 
5244  cf = nInitChar(n_GF, &param);
5245  }
5246  else // (0/p, a, b, ..., z)
5247  {
5248  if ((ch!=0) && (ch!=IsPrime(ch)))
5249  {
5250  WerrorS("too many parameters");
5251  goto rInitError;
5252  }
5253 
5254  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5255 
5256  if (rSleftvList2StringArray(pn, names))
5257  {
5258  WerrorS("parameter expected");
5259  goto rInitError;
5260  }
5261 
5262  TransExtInfo extParam;
5263 
5264  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5265  for(int i=pars-1; i>=0;i--)
5266  {
5267  omFree(names[i]);
5268  }
5269  omFree(names);
5270 
5271  cf = nInitChar(n_transExt, &extParam);
5272  }
5273  }
5274 
5275 // if (cf==NULL) goto rInitError;
5276  assume( cf != NULL );
5277  }
5278  else if ((pn->name != NULL)
5279  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5280  {
5281  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5282  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5283  {
5284  float_len=(int)(long)pn->next->Data();
5285  float_len2=float_len;
5286  pn=pn->next;
5287  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5288  {
5289  float_len2=(int)(long)pn->next->Data();
5290  pn=pn->next;
5291  }
5292  }
5293 
5294  if (!complex_flag)
5295  complex_flag= pn->next != NULL;
5296  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5297  cf=nInitChar(n_R, NULL);
5298  else // longR or longC?
5299  {
5300  LongComplexInfo param;
5301 
5302  param.float_len = si_min (float_len, 32767);
5303  param.float_len2 = si_min (float_len2, 32767);
5304 
5305  // set the parameter name
5306  if (complex_flag)
5307  {
5308  if (param.float_len < SHORT_REAL_LENGTH)
5309  {
5312  }
5313  if (pn->next == NULL)
5314  param.par_name=(const char*)"i"; //default to i
5315  else
5316  param.par_name = (const char*)pn->next->name;
5317  }
5318 
5319  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5320  }
5321  assume( cf != NULL );
5322  }
5323 #ifdef HAVE_RINGS
5324  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5325  {
5326  // TODO: change to use coeffs_BIGINT!?
5327  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
5328  mpz_init_set_si(modBase, 0);
5329  if (pn->next!=NULL)
5330  {
5331  if (pn->next->Typ()==INT_CMD)
5332  {
5333  mpz_set_ui(modBase, (int)(long) pn->next->Data());
5334  pn=pn->next;
5335  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5336  {
5337  modExponent = (long) pn->next->Data();
5338  pn=pn->next;
5339  }
5340  while ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5341  {
5342  mpz_mul_ui(modBase, modBase, (int)(long) pn->next->Data());
5343  pn=pn->next;
5344  }
5345  }
5346  else if (pn->next->Typ()==BIGINT_CMD)
5347  {
5348  number p=(number)pn->next->CopyD(); // FIXME: why CopyD() here if nlGMP should not overtake p!?
5349  nlGMP(p,(number)modBase,coeffs_BIGINT); // TODO? // extern void nlGMP(number &i, number n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
5350  n_Delete(&p,coeffs_BIGINT);
5351  }
5352  }
5353  else
5354  cf=nInitChar(n_Z,NULL);
5355 
5356  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
5357  {
5358  Werror("Wrong ground ring specification (module is 1)");
5359  goto rInitError;
5360  }
5361  if (modExponent < 1)
5362  {
5363  Werror("Wrong ground ring specification (exponent smaller than 1");
5364  goto rInitError;
5365  }
5366  // module is 0 ---> integers ringtype = 4;
5367  // we have an exponent
5368  if (modExponent > 1 && cf == NULL)
5369  {
5370  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5371  {
5372  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5373  depending on the size of a long on the respective platform */
5374  //ringtype = 1; // Use Z/2^ch
5375  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5376  mpz_clear(modBase);
5377  omFreeSize (modBase, sizeof (mpz_t));
5378  }
5379  else
5380  {
5381  if (mpz_cmp_ui(modBase,0)==0)
5382  {
5383  WerrorS("modulus must not be 0 or parameter not allowed");
5384  goto rInitError;
5385  }
5386  //ringtype = 3;
5387  ZnmInfo info;
5388  info.base= modBase;
5389  info.exp= modExponent;
5390  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5391  }
5392  }
5393  // just a module m > 1
5394  else if (cf == NULL)
5395  {
5396  if (mpz_cmp_ui(modBase,0)==0)
5397  {
5398  WerrorS("modulus must not be 0 or parameter not allowed");
5399  goto rInitError;
5400  }
5401  //ringtype = 2;
5402  ZnmInfo info;
5403  info.base= modBase;
5404  info.exp= modExponent;
5405  cf=nInitChar(n_Zn,(void*) &info);
5406  }
5407  assume( cf != NULL );
5408  }
5409 #endif
5410  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5411  else if ((pn->Typ()==RING_CMD) && (P == 1))
5412  {
5413  TransExtInfo extParam;
5414  extParam.r = (ring)pn->Data();
5415  cf = nInitChar(n_transExt, &extParam);
5416  }
5417  else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5418  {
5419  AlgExtInfo extParam;
5420  extParam.r = (ring)pn->Data();
5421 
5422  cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5423  }
5424  else
5425  {
5426  Werror("Wrong or unknown ground field specification");
5427 #ifndef SING_NDEBUG
5428  sleftv* p = pn;
5429  while (p != NULL)
5430  {
5431  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5432  PrintLn();
5433  p = p->next;
5434  }
5435 #endif
5436  goto rInitError;
5437  }
5438 // pn=pn->next;
5439 
5440  /*every entry in the new ring is initialized to 0*/
5441 
5442  /* characteristic -----------------------------------------------*/
5443  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5444  * 0 1 : Q(a,...) *names FALSE
5445  * 0 -1 : R NULL FALSE 0
5446  * 0 -1 : R NULL FALSE prec. >6
5447  * 0 -1 : C *names FALSE prec. 0..?
5448  * p p : Fp NULL FALSE
5449  * p -p : Fp(a) *names FALSE
5450  * q q : GF(q=p^n) *names TRUE
5451  */
5452  if (cf==NULL)
5453  {
5454  Werror("Invalid ground field specification");
5455  goto rInitError;
5456 // const int ch=32003;
5457 // cf=nInitChar(n_Zp, (void*)(long)ch);
5458  }
5459 
5460  assume( R != NULL );
5461 
5462  R->cf = cf;
5463 
5464  /* names and number of variables-------------------------------------*/
5465  {
5466  int l=rv->listLength();
5467 
5468  if (l>MAX_SHORT)
5469  {
5470  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5471  goto rInitError;
5472  }
5473  R->N = l; /*rv->listLength();*/
5474  }
5475  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5476  if (rSleftvList2StringArray(rv, R->names))
5477  {
5478  WerrorS("name of ring variable expected");
5479  goto rInitError;
5480  }
5481 
5482  /* check names and parameters for conflicts ------------------------- */
5483  rRenameVars(R); // conflicting variables will be renamed
5484  /* ordering -------------------------------------------------------------*/
5485  if (rSleftvOrdering2Ordering(ord, R))
5486  goto rInitError;
5487 
5488  // Complete the initialization
5489  if (rComplete(R,1))
5490  goto rInitError;
5491 
5492 /*#ifdef HAVE_RINGS
5493 // currently, coefficients which are ring elements require a global ordering:
5494  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5495  {
5496  WerrorS("global ordering required for these coefficients");
5497  goto rInitError;
5498  }
5499 #endif*/
5500 
5501  rTest(R);
5502 
5503  // try to enter the ring into the name list
5504  // need to clean up sleftv here, before this ring can be set to
5505  // new currRing or currRing can be killed beacuse new ring has
5506  // same name
5507  if (pn != NULL) pn->CleanUp();
5508  if (rv != NULL) rv->CleanUp();
5509  if (ord != NULL) ord->CleanUp();
5510  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5511  // goto rInitError;
5512 
5513  //memcpy(IDRING(tmp),R,sizeof(*R));
5514  // set current ring
5515  //omFreeBin(R, ip_sring_bin);
5516  //return tmp;
5517  return R;
5518 
5519  // error case:
5520  rInitError:
5521  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5522  if (pn != NULL) pn->CleanUp();
5523  if (rv != NULL) rv->CleanUp();
5524  if (ord != NULL) ord->CleanUp();
5525  return NULL;
5526 }
mpz_ptr base
Definition: rmodulon.h:18
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void PrintLn()
Definition: reporter.cc:322
#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:5166
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:4862
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:23
void nlGMP(number &i, number n, const coeffs r)
Definition: longrat.cc:1410
coeffs coeffs_BIGINT
Definition: ipid.cc:53
int Typ()
Definition: subexpr.cc:955
#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:1520
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:3435
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
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
#define info
Definition: libparse.cc:1254
int i
Definition: cfEzgcd.cc:123
int IsPrime(int p)
Definition: prime.cc:61
static void rRenameVars(ring R)
Definition: ipshell.cc:2089
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
#define R
Definition: sirandom.c:26
void CleanUp(ring r=currRing)
Definition: subexpr.cc:307
void * Data()
Definition: subexpr.cc:1097
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 'p'
Definition: coeffs.h:456
kBucketDestroy & P
Definition: myNF.cc:191
BOOLEAN rSleftvList2StringArray(sleftv *sl, char **p)
Definition: ipshell.cc:5135
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
void * CopyD(int t)
Definition: subexpr.cc:662
#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 5690 of file ipshell.cc.

5691 {
5692  if ((r->ref<=0)&&(r->order!=NULL))
5693  {
5694 #ifdef RDEBUG
5695  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
5696 #endif
5697  if (r->qideal!=NULL)
5698  {
5699  id_Delete(&r->qideal, r);
5700  r->qideal = NULL;
5701  }
5702  int j;
5703 #ifdef USE_IILOCALRING
5704  for (j=0;j<myynest;j++)
5705  {
5706  if (iiLocalRing[j]==r)
5707  {
5708  if (j+1==myynest) Warn("killing the basering for level %d",j);
5709  iiLocalRing[j]=NULL;
5710  }
5711  }
5712 #else /* USE_IILOCALRING */
5713 //#endif /* USE_IILOCALRING */
5714  {
5715  proclevel * nshdl = procstack;
5716  int lev=myynest-1;
5717 
5718  for(; nshdl != NULL; nshdl = nshdl->next)
5719  {
5720  if (nshdl->cRing==r)
5721  {
5722  Warn("killing the basering for level %d",lev);
5723  nshdl->cRing=NULL;
5724  nshdl->cRingHdl=NULL;
5725  }
5726  }
5727  }
5728 #endif /* USE_IILOCALRING */
5729 // any variables depending on r ?
5730  while (r->idroot!=NULL)
5731  {
5732  r->idroot->lev=myynest; // avoid warning about kill global objects
5733  killhdl2(r->idroot,&(r->idroot),r);
5734  }
5735  if (r==currRing)
5736  {
5737  // all dependend stuff is done, clean global vars:
5738  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
5740  {
5742  }
5743  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
5744  //{
5745  // WerrorS("return value depends on local ring variable (export missing ?)");
5746  // iiRETURNEXPR.CleanUp();
5747  //}
5748  currRing=NULL;
5749  currRingHdl=NULL;
5750  }
5751 
5752  /* nKillChar(r); will be called from inside of rDelete */
5753  rDelete(r);
5754  return;
5755  }
5756  r->ref--;
5757 }
#define TRACE_SHOW_RINGS
Definition: reporter.h:33
#define Print
Definition: emacs.cc:83
proclevel * procstack
Definition: ipid.cc:57
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:400
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:375
int j
Definition: myNF.cc:70
Definition: ipid.h:56
idhdl currRingHdl
Definition: ipid.cc:64
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:307
#define Warn
Definition: emacs.cc:80
void rKill ( idhdl  h)

Definition at line 5759 of file ipshell.cc.

5760 {
5761  ring r = IDRING(h);
5762  int ref=0;
5763  if (r!=NULL)
5764  {
5765  ref=r->ref;
5766  rKill(r);
5767  }
5768  if (h==currRingHdl)
5769  {
5770  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
5771  else
5772  {
5774  }
5775  }
5776 }
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:5690
idhdl currRingHdl
Definition: ipid.cc:64
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1565
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 4750 of file ipshell.cc.

4751 {
4752  // change some bad orderings/combination into better ones
4753  leftv h=ord;
4754  while(h!=NULL)
4755  {
4756  BOOLEAN change=FALSE;
4757  intvec *iv = (intvec *)(h->data);
4758  // ws(-i) -> wp(i)
4759  if ((*iv)[1]==ringorder_ws)
4760  {
4761  BOOLEAN neg=TRUE;
4762  for(int i=2;i<iv->length();i++)
4763  if((*iv)[i]>=0) { neg=FALSE; break; }
4764  if (neg)
4765  {
4766  (*iv)[1]=ringorder_wp;
4767  for(int i=2;i<iv->length();i++)
4768  (*iv)[i]= - (*iv)[i];
4769  change=TRUE;
4770  }
4771  }
4772  // Ws(-i) -> Wp(i)
4773  if ((*iv)[1]==ringorder_Ws)
4774  {
4775  BOOLEAN neg=TRUE;
4776  for(int i=2;i<iv->length();i++)
4777  if((*iv)[i]>=0) { neg=FALSE; break; }
4778  if (neg)
4779  {
4780  (*iv)[1]=ringorder_Wp;
4781  for(int i=2;i<iv->length();i++)
4782  (*iv)[i]= -(*iv)[i];
4783  change=TRUE;
4784  }
4785  }
4786  // wp(1) -> dp
4787  if ((*iv)[1]==ringorder_wp)
4788  {
4789  BOOLEAN all_one=TRUE;
4790  for(int i=2;i<iv->length();i++)
4791  if((*iv)[i]!=1) { all_one=FALSE; break; }
4792  if (all_one)
4793  {
4794  intvec *iv2=new intvec(3);
4795  (*iv2)[0]=1;
4796  (*iv2)[1]=ringorder_dp;
4797  (*iv2)[2]=iv->length()-2;
4798  delete iv;
4799  iv=iv2;
4800  h->data=iv2;
4801  change=TRUE;
4802  }
4803  }
4804  // Wp(1) -> Dp
4805  if ((*iv)[1]==ringorder_Wp)
4806  {
4807  BOOLEAN all_one=TRUE;
4808  for(int i=2;i<iv->length();i++)
4809  if((*iv)[i]!=1) { all_one=FALSE; break; }
4810  if (all_one)
4811  {
4812  intvec *iv2=new intvec(3);
4813  (*iv2)[0]=1;
4814  (*iv2)[1]=ringorder_Dp;
4815  (*iv2)[2]=iv->length()-2;
4816  delete iv;
4817  iv=iv2;
4818  h->data=iv2;
4819  change=TRUE;
4820  }
4821  }
4822  // dp(1)/Dp(1)/rp(1) -> lp(1)
4823  if (((*iv)[1]==ringorder_dp)
4824  || ((*iv)[1]==ringorder_Dp)
4825  || ((*iv)[1]==ringorder_rp))
4826  {
4827  if (iv->length()==3)
4828  {
4829  if ((*iv)[2]==1)
4830  {
4831  (*iv)[1]=ringorder_lp;
4832  change=TRUE;
4833  }
4834  }
4835  }
4836  // lp(i),lp(j) -> lp(i+j)
4837  if(((*iv)[1]==ringorder_lp)
4838  && (h->next!=NULL))
4839  {
4840  intvec *iv2 = (intvec *)(h->next->data);
4841  if ((*iv2)[1]==ringorder_lp)
4842  {
4843  leftv hh=h->next;
4844  h->next=hh->next;
4845  hh->next=NULL;
4846  if ((*iv2)[0]==1)
4847  (*iv)[2] += 1; // last block unspecified, at least 1
4848  else
4849  (*iv)[2] += (*iv2)[2];
4850  hh->CleanUp();
4851  omFree(hh);
4852  change=TRUE;
4853  }
4854  }
4855  // -------------------
4856  if (!change) h=h->next;
4857  }
4858  return ord;
4859 }
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:307
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
static void rRenameVars ( ring  R)
static

Definition at line 2089 of file ipshell.cc.

2090 {
2091  int i,j;
2092  BOOLEAN ch;
2093  do
2094  {
2095  ch=0;
2096  for(i=0;i<R->N-1;i++)
2097  {
2098  for(j=i+1;j<R->N;j++)
2099  {
2100  if (strcmp(R->names[i],R->names[j])==0)
2101  {
2102  ch=TRUE;
2103  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2104  omFree(R->names[j]);
2105  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2106  sprintf(R->names[j],"@%s",R->names[i]);
2107  }
2108  }
2109  }
2110  }
2111  while (ch);
2112  for(i=0;i<rPar(R); i++)
2113  {
2114  for(j=0;j<R->N;j++)
2115  {
2116  if (strcmp(rParameter(R)[i],R->names[j])==0)
2117  {
2118  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2119 // omFree(rParameter(R)[i]);
2120 // rParameter(R)[i]=(char *)omAlloc(10);
2121 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2122  omFree(R->names[j]);
2123  R->names[j]=(char *)omAlloc(10);
2124  sprintf(R->names[j],"@@(%d)",i+1);
2125  }
2126  }
2127  }
2128 }
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
int i
Definition: cfEzgcd.cc:123
#define R
Definition: sirandom.c:26
int BOOLEAN
Definition: auxiliary.h:131
#define Warn
Definition: emacs.cc:80
void rSetHdl ( idhdl  h)

Definition at line 4696 of file ipshell.cc.

4697 {
4698  ring rg = NULL;
4699  if (h!=NULL)
4700  {
4701 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
4702  rg = IDRING(h);
4703  if (rg==NULL) return; //id <>NULL, ring==NULL
4704  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
4705  if (IDID(h)) // OB: ????
4706  omCheckAddr((ADDRESS)IDID(h));
4707  rTest(rg);
4708  }
4709 
4710  // clean up history
4712  {
4714  memset(&sLastPrinted,0,sizeof(sleftv));
4715  }
4716 
4717  if ((rg!=currRing)&&(currRing!=NULL))
4718  {
4720  if (DENOMINATOR_LIST!=NULL)
4721  {
4722  if (TEST_V_ALLWARN)
4723  Warn("deleting denom_list for ring change to %s",IDID(h));
4724  do
4725  {
4726  n_Delete(&(dd->n),currRing->cf);
4727  dd=dd->next;
4729  DENOMINATOR_LIST=dd;
4730  } while(DENOMINATOR_LIST!=NULL);
4731  }
4732  }
4733 
4734  // test for valid "currRing":
4735  if ((rg!=NULL) && (rg->idroot==NULL))
4736  {
4737  ring old=rg;
4738  rg=rAssure_HasComp(rg);
4739  if (old!=rg)
4740  {
4741  rKill(old);
4742  IDRING(h)=rg;
4743  }
4744  }
4745  /*------------ change the global ring -----------------------*/
4746  rChangeCurrRing(rg);
4747  currRingHdl = h;
4748 }
#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:375
void rKill(ring r)
Definition: ipshell.cc:5690
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:781
idhdl currRingHdl
Definition: ipid.cc:64
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:307
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
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 5778 of file ipshell.cc.

5779 {
5780  //idhdl next_best=NULL;
5781  idhdl h=root;
5782  while (h!=NULL)
5783  {
5784  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
5785  && (h!=n)
5786  && (IDRING(h)==r)
5787  )
5788  {
5789  // if (IDLEV(h)==myynest)
5790  // return h;
5791  // if ((IDLEV(h)==0) || (next_best==NULL))
5792  // next_best=h;
5793  // else if (IDLEV(next_best)<IDLEV(h))
5794  // next_best=h;
5795  return h;
5796  }
5797  h=IDNEXT(h);
5798  }
5799  //return next_best;
5800  return NULL;
5801 }
#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 5135 of file ipshell.cc.

5136 {
5137 
5138  while(sl!=NULL)
5139  {
5140  if (sl->Name() == sNoName)
5141  {
5142  if (sl->Typ()==POLY_CMD)
5143  {
5144  sleftv s_sl;
5145  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5146  if (s_sl.Name() != sNoName)
5147  *p = omStrDup(s_sl.Name());
5148  else
5149  *p = NULL;
5150  sl->next = s_sl.next;
5151  s_sl.next = NULL;
5152  s_sl.CleanUp();
5153  if (*p == NULL) return TRUE;
5154  }
5155  else
5156  return TRUE;
5157  }
5158  else
5159  *p = omStrDup(sl->Name());
5160  p++;
5161  sl=sl->next;
5162  }
5163  return FALSE;
5164 }
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:955
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:287
void CleanUp(ring r=currRing)
Definition: subexpr.cc:307
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 4862 of file ipshell.cc.

4863 {
4864  int last = 0, o=0, n = 1, i=0, typ = 1, j;
4865  ord=rOptimizeOrdAsSleftv(ord);
4866  sleftv *sl = ord;
4867 
4868  // determine nBlocks
4869  while (sl!=NULL)
4870  {
4871  intvec *iv = (intvec *)(sl->data);
4872  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
4873  i++;
4874  else if ((*iv)[1]==ringorder_L)
4875  {
4876  R->bitmask=(*iv)[2];
4877  n--;
4878  }
4879  else if (((*iv)[1]!=ringorder_a)
4880  && ((*iv)[1]!=ringorder_a64)
4881  && ((*iv)[1]!=ringorder_am))
4882  o++;
4883  n++;
4884  sl=sl->next;
4885  }
4886  // check whether at least one real ordering
4887  if (o==0)
4888  {
4889  WerrorS("invalid combination of orderings");
4890  return TRUE;
4891  }
4892  // if no c/C ordering is given, increment n
4893  if (i==0) n++;
4894  else if (i != 1)
4895  {
4896  // throw error if more than one is given
4897  WerrorS("more than one ordering c/C specified");
4898  return TRUE;
4899  }
4900 
4901  // initialize fields of R
4902  R->order=(int *)omAlloc0(n*sizeof(int));
4903  R->block0=(int *)omAlloc0(n*sizeof(int));
4904  R->block1=(int *)omAlloc0(n*sizeof(int));
4905  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
4906 
4907  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
4908 
4909  // init order, so that rBlocks works correctly
4910  for (j=0; j < n-1; j++)
4911  R->order[j] = (int) ringorder_unspec;
4912  // set last _C order, if no c/C order was given
4913  if (i == 0) R->order[n-2] = ringorder_C;
4914 
4915  /* init orders */
4916  sl=ord;
4917  n=-1;
4918  while (sl!=NULL)
4919  {
4920  intvec *iv;
4921  iv = (intvec *)(sl->data);
4922  if ((*iv)[1]!=ringorder_L)
4923  {
4924  n++;
4925 
4926  /* the format of an ordering:
4927  * iv[0]: factor
4928  * iv[1]: ordering
4929  * iv[2..end]: weights
4930  */
4931  R->order[n] = (*iv)[1];
4932  typ=1;
4933  switch ((*iv)[1])
4934  {
4935  case ringorder_ws:
4936  case ringorder_Ws:
4937  typ=-1;
4938  case ringorder_wp:
4939  case ringorder_Wp:
4940  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
4941  R->block0[n] = last+1;
4942  for (i=2; i<iv->length(); i++)
4943  {
4944  R->wvhdl[n][i-2] = (*iv)[i];
4945  last++;
4946  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
4947  }
4948  R->block1[n] = last;
4949  break;
4950  case ringorder_ls:
4951  case ringorder_ds:
4952  case ringorder_Ds:
4953  case ringorder_rs:
4954  typ=-1;
4955  case ringorder_lp:
4956  case ringorder_dp:
4957  case ringorder_Dp:
4958  case ringorder_rp:
4959  R->block0[n] = last+1;
4960  if (iv->length() == 3) last+=(*iv)[2];
4961  else last += (*iv)[0];
4962  R->block1[n] = last;
4963  //if ((R->block0[n]>R->block1[n])
4964  //|| (R->block1[n]>rVar(R)))
4965  //{
4966  // R->block1[n]=rVar(R);
4967  // //WerrorS("ordering larger than number of variables");
4968  // break;
4969  //}
4970  if (rCheckIV(iv)) return TRUE;
4971  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
4972  {
4973  if (weights[i]==0) weights[i]=typ;
4974  }
4975  break;
4976 
4977  case ringorder_s: // no 'rank' params!
4978  {
4979 
4980  if(iv->length() > 3)
4981  return TRUE;
4982 
4983  if(iv->length() == 3)
4984  {
4985  const int s = (*iv)[2];
4986  R->block0[n] = s;
4987  R->block1[n] = s;
4988  }
4989  break;
4990  }
4991  case ringorder_IS:
4992  {
4993  if(iv->length() != 3) return TRUE;
4994 
4995  const int s = (*iv)[2];
4996 
4997  if( 1 < s || s < -1 ) return TRUE;
4998 
4999  R->block0[n] = s;
5000  R->block1[n] = s;
5001  break;
5002  }
5003  case ringorder_S:
5004  case ringorder_c:
5005  case ringorder_C:
5006  {
5007  if (rCheckIV(iv)) return TRUE;
5008  break;
5009  }
5010  case ringorder_aa:
5011  case ringorder_a:
5012  {
5013  R->block0[n] = last+1;
5014  R->block1[n] = si_min(last+iv->length()-2 , rVar(R));
5015  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5016  for (i=2; i<iv->length(); i++)
5017  {
5018  R->wvhdl[n][i-2]=(*iv)[i];
5019  last++;
5020  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5021  }
5022  last=R->block0[n]-1;
5023  break;
5024  }
5025  case ringorder_am:
5026  {
5027  R->block0[n] = last+1;
5028  R->block1[n] = si_min(last+iv->length()-2 , rVar(R));
5029  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5030  if (R->block1[n]- R->block0[n]+2>=iv->length())
5031  WarnS("missing module weights");
5032  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5033  {
5034  R->wvhdl[n][i-2]=(*iv)[i];
5035  last++;
5036  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5037  }
5038  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5039  for (; i<iv->length(); i++)
5040  {
5041  R->wvhdl[n][i-1]=(*iv)[i];
5042  }
5043  last=R->block0[n]-1;
5044  break;
5045  }
5046  case ringorder_a64:
5047  {
5048  R->block0[n] = last+1;
5049  R->block1[n] = si_min(last+iv->length()-2 , rVar(R));
5050  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5051  int64 *w=(int64 *)R->wvhdl[n];
5052  for (i=2; i<iv->length(); i++)
5053  {
5054  w[i-2]=(*iv)[i];
5055  last++;
5056  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5057  }
5058  last=R->block0[n]-1;
5059  break;
5060  }
5061  case ringorder_M:
5062  {
5063  int Mtyp=rTypeOfMatrixOrder(iv);
5064  if (Mtyp==0) return TRUE;
5065  if (Mtyp==-1) typ = -1;
5066 
5067  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5068  for (i=2; i<iv->length();i++)
5069  R->wvhdl[n][i-2]=(*iv)[i];
5070 
5071  R->block0[n] = last+1;
5072  last += (int)sqrt((double)(iv->length()-2));
5073  R->block1[n] = last;
5074  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5075  {
5076  if (weights[i]==0) weights[i]=typ;
5077  }
5078  break;
5079  }
5080 
5081  case ringorder_no:
5082  R->order[n] = ringorder_unspec;
5083  return TRUE;
5084 
5085  default:
5086  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5087  R->order[n] = ringorder_unspec;
5088  return TRUE;
5089  }
5090  }
5091  sl=sl->next;
5092  }
5093 
5094  // check for complete coverage
5095  while ( n >= 0 && (
5096  (R->order[n]==ringorder_c)
5097  || (R->order[n]==ringorder_C)
5098  || (R->order[n]==ringorder_s)
5099  || (R->order[n]==ringorder_S)
5100  || (R->order[n]==ringorder_IS)
5101  )) n--;
5102 
5103  assume( n >= 0 );
5104 
5105  if (R->block1[n] != R->N)
5106  {
5107  if (((R->order[n]==ringorder_dp) ||
5108  (R->order[n]==ringorder_ds) ||
5109  (R->order[n]==ringorder_Dp) ||
5110  (R->order[n]==ringorder_Ds) ||
5111  (R->order[n]==ringorder_rp) ||
5112  (R->order[n]==ringorder_rs) ||
5113  (R->order[n]==ringorder_lp) ||
5114  (R->order[n]==ringorder_ls))
5115  &&
5116  R->block0[n] <= R->N)
5117  {
5118  R->block1[n] = R->N;
5119  }
5120  else
5121  {
5122  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5123  R->N,R->block1[n]);
5124  return TRUE;
5125  }
5126  }
5127  // find OrdSgn:
5128  R->OrdSgn = 1;
5129  for(i=1;i<=R->N;i++)
5130  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5131  omFree(weights);
5132  return FALSE;
5133 }
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
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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:23
#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:4750
BOOLEAN rCheckIV(intvec *iv)
Definition: ring.cc:185
#define assume(x)
Definition: mod2.h:405
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
#define R
Definition: sirandom.c:26
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 5528 of file ipshell.cc.

5529 {
5530  ring R = rCopy0(org_ring);
5531  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
5532  int n = rBlocks(org_ring), i=0, j;
5533 
5534  /* names and number of variables-------------------------------------*/
5535  {
5536  int l=rv->listLength();
5537  if (l>MAX_SHORT)
5538  {
5539  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5540  goto rInitError;
5541  }
5542  R->N = l; /*rv->listLength();*/
5543  }
5544  omFree(R->names);
5545  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5546  if (rSleftvList2StringArray(rv, R->names))
5547  {
5548  WerrorS("name of ring variable expected");
5549  goto rInitError;
5550  }
5551 
5552  /* check names for subring in org_ring ------------------------- */
5553  {
5554  i=0;
5555 
5556  for(j=0;j<R->N;j++)
5557  {
5558  for(;i<org_ring->N;i++)
5559  {
5560  if (strcmp(org_ring->names[i],R->names[j])==0)
5561  {
5562  perm[i+1]=j+1;
5563  break;
5564  }
5565  }
5566  if (i>org_ring->N)
5567  {
5568  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5569  break;
5570  }
5571  }
5572  }
5573  //Print("perm=");
5574  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
5575  /* ordering -------------------------------------------------------------*/
5576 
5577  for(i=0;i<n;i++)
5578  {
5579  int min_var=-1;
5580  int max_var=-1;
5581  for(j=R->block0[i];j<=R->block1[i];j++)
5582  {
5583  if (perm[j]>0)
5584  {
5585  if (min_var==-1) min_var=perm[j];
5586  max_var=perm[j];
5587  }
5588  }
5589  if (min_var!=-1)
5590  {
5591  //Print("block %d: old %d..%d, now:%d..%d\n",
5592  // i,R->block0[i],R->block1[i],min_var,max_var);
5593  R->block0[i]=min_var;
5594  R->block1[i]=max_var;
5595  if (R->wvhdl[i]!=NULL)
5596  {
5597  omFree(R->wvhdl[i]);
5598  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
5599  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
5600  {
5601  if (perm[j]>0)
5602  {
5603  R->wvhdl[i][perm[j]-R->block0[i]]=
5604  org_ring->wvhdl[i][j-org_ring->block0[i]];
5605  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
5606  }
5607  }
5608  }
5609  }
5610  else
5611  {
5612  if(R->block0[i]>0)
5613  {
5614  //Print("skip block %d\n",i);
5615  R->order[i]=ringorder_unspec;
5616  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
5617  R->wvhdl[i]=NULL;
5618  }
5619  //else Print("keep block %d\n",i);
5620  }
5621  }
5622  i=n-1;
5623  while(i>0)
5624  {
5625  // removed unneded blocks
5626  if(R->order[i-1]==ringorder_unspec)
5627  {
5628  for(j=i;j<=n;j++)
5629  {
5630  R->order[j-1]=R->order[j];
5631  R->block0[j-1]=R->block0[j];
5632  R->block1[j-1]=R->block1[j];
5633  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
5634  R->wvhdl[j-1]=R->wvhdl[j];
5635  }
5636  R->order[n]=ringorder_unspec;
5637  n--;
5638  }
5639  i--;
5640  }
5641  n=rBlocks(org_ring)-1;
5642  while (R->order[n]==0) n--;
5643  while (R->order[n]==ringorder_unspec) n--;
5644  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
5645  if (R->block1[n] != R->N)
5646  {
5647  if (((R->order[n]==ringorder_dp) ||
5648  (R->order[n]==ringorder_ds) ||
5649  (R->order[n]==ringorder_Dp) ||
5650  (R->order[n]==ringorder_Ds) ||
5651  (R->order[n]==ringorder_rp) ||
5652  (R->order[n]==ringorder_rs) ||
5653  (R->order[n]==ringorder_lp) ||
5654  (R->order[n]==ringorder_ls))
5655  &&
5656  R->block0[n] <= R->N)
5657  {
5658  R->block1[n] = R->N;
5659  }
5660  else
5661  {
5662  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
5663  R->N,R->block1[n],n);
5664  return NULL;
5665  }
5666  }
5667  omFree(perm);
5668  // find OrdSgn:
5669  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
5670  //for(i=1;i<=R->N;i++)
5671  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
5672  //omFree(weights);
5673  // Complete the initialization
5674  if (rComplete(R,1))
5675  goto rInitError;
5676 
5677  rTest(R);
5678 
5679  if (rv != NULL) rv->CleanUp();
5680 
5681  return R;
5682 
5683  // error case:
5684  rInitError:
5685  if (R != NULL) rDelete(R);
5686  if (rv != NULL) rv->CleanUp();
5687  return NULL;
5688 }
const short MAX_SHORT
Definition: ipshell.cc:5166
opposite of ls
Definition: ring.h:694
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
int listLength()
Definition: subexpr.cc:61
void WerrorS(const char *s)
Definition: feFopen.cc:23
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:3435
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
#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
#define R
Definition: sirandom.c:26
void CleanUp(ring r=currRing)
Definition: subexpr.cc:307
int perm[100]
BOOLEAN rSleftvList2StringArray(sleftv *sl, char **p)
Definition: ipshell.cc:5135
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 1012 of file ipshell.cc.

1013 {
1014  int i;
1015  indset save;
1017 
1018  hexist = hInit(S, Q, &hNexist, currRing);
1019  if (hNexist == 0)
1020  {
1021  intvec *iv=new intvec(rVar(currRing));
1022  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1023  res->Init(1);
1024  res->m[0].rtyp=INTVEC_CMD;
1025  res->m[0].data=(intvec*)iv;
1026  return res;
1027  }
1028  else if (hisModule!=0)
1029  {
1030  res->Init(0);
1031  return res;
1032  }
1033  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1034  hMu = 0;
1035  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1036  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1037  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1038  hrad = hexist;
1039  hNrad = hNexist;
1040  radmem = hCreate(rVar(currRing) - 1);
1041  hCo = rVar(currRing) + 1;
1042  hNvar = rVar(currRing);
1043  hRadical(hrad, &hNrad, hNvar);
1044  hSupp(hrad, hNrad, hvar, &hNvar);
1045  if (hNvar)
1046  {
1047  hCo = hNvar;
1048  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1049  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1050  hLexR(hrad, hNrad, hvar, hNvar);
1052  }
1053  if (hCo && (hCo < rVar(currRing)))
1054  {
1056  }
1057  if (hMu!=0)
1058  {
1059  ISet = save;
1060  hMu2 = 0;
1061  if (all && (hCo+1 < rVar(currRing)))
1062  {
1065  i=hMu+hMu2;
1066  res->Init(i);
1067  if (hMu2 == 0)
1068  {
1070  }
1071  }
1072  else
1073  {
1074  res->Init(hMu);
1075  }
1076  for (i=0;i<hMu;i++)
1077  {
1078  res->m[i].data = (void *)save->set;
1079  res->m[i].rtyp = INTVEC_CMD;
1080  ISet = save;
1081  save = save->nx;
1083  }
1084  omFreeBin((ADDRESS)save, indlist_bin);
1085  if (hMu2 != 0)
1086  {
1087  save = JSet;
1088  for (i=hMu;i<hMu+hMu2;i++)
1089  {
1090  res->m[i].data = (void *)save->set;
1091  res->m[i].rtyp = INTVEC_CMD;
1092  JSet = save;
1093  save = save->nx;
1095  }
1096  omFreeBin((ADDRESS)save, indlist_bin);
1097  }
1098  }
1099  else
1100  {
1101  res->Init(0);
1103  }
1104  hKill(radmem, rVar(currRing) - 1);
1105  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1106  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1107  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1109  return res;
1110 }
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 4132 of file ipshell.cc.

4133 {
4134  sleftv tmp;
4135  memset(&tmp,0,sizeof(tmp));
4136  tmp.rtyp=INT_CMD;
4137  /* tmp.data = (void *)0; -- done by memset */
4138 
4139  return semicProc3(res,u,v,&tmp);
4140 }
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:4092
int rtyp
Definition: subexpr.h:92
BOOLEAN semicProc3 ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 4092 of file ipshell.cc.

4093 {
4094  semicState state;
4095  BOOLEAN qh=(((int)(long)w->Data())==1);
4096 
4097  // -----------------
4098  // check arguments
4099  // -----------------
4100 
4101  lists l1 = (lists)u->Data( );
4102  lists l2 = (lists)v->Data( );
4103 
4104  if( (state=list_is_spectrum( l1 ))!=semicOK )
4105  {
4106  WerrorS( "first argument is not a spectrum" );
4107  list_error( state );
4108  }
4109  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4110  {
4111  WerrorS( "second argument is not a spectrum" );
4112  list_error( state );
4113  }
4114  else
4115  {
4116  spectrum s1= spectrumFromList( l1 );
4117  spectrum s2= spectrumFromList( l2 );
4118 
4119  res->rtyp = INT_CMD;
4120  if (qh)
4121  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4122  else
4123  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4124  }
4125 
4126  // -----------------
4127  // check status
4128  // -----------------
4129 
4130  return (state!=semicOK);
4131 }
Definition: tok.h:85
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:2965
void list_error(semicState state)
Definition: ipshell.cc:3049
void WerrorS(const char *s)
Definition: feFopen.cc:23
Definition: semic.h:63
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:3834
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3015
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1097
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 4009 of file ipshell.cc.

4010 {
4011  semicState state;
4012 
4013  // -----------------
4014  // check arguments
4015  // -----------------
4016 
4017  lists l1 = (lists)first->Data( );
4018  lists l2 = (lists)second->Data( );
4019 
4020  if( (state=list_is_spectrum( l1 )) != semicOK )
4021  {
4022  WerrorS( "first argument is not a spectrum:" );
4023  list_error( state );
4024  }
4025  else if( (state=list_is_spectrum( l2 )) != semicOK )
4026  {
4027  WerrorS( "second argument is not a spectrum:" );
4028  list_error( state );
4029  }
4030  else
4031  {
4032  spectrum s1= spectrumFromList ( l1 );
4033  spectrum s2= spectrumFromList ( l2 );
4034  spectrum sum( s1+s2 );
4035 
4036  result->rtyp = LIST_CMD;
4037  result->data = (char*)(getList(sum));
4038  }
4039 
4040  return (state!=semicOK);
4041 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:2965
void list_error(semicState state)
Definition: ipshell.cc:3049
void WerrorS(const char *s)
Definition: feFopen.cc:23
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:2977
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:3834
semicState
Definition: ipshell.cc:3015
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1097
Definition: tok.h:96
spectrumState spectrumCompute ( poly  h,
lists L,
int  fast 
)

Definition at line 3391 of file ipshell.cc.

3392 {
3393  int i;
3394 
3395  #ifdef SPECTRUM_DEBUG
3396  #ifdef SPECTRUM_PRINT
3397  #ifdef SPECTRUM_IOSTREAM
3398  cout << "spectrumCompute\n";
3399  if( fast==0 ) cout << " no optimization" << endl;
3400  if( fast==1 ) cout << " weight optimization" << endl;
3401  if( fast==2 ) cout << " symmetry optimization" << endl;
3402  #else
3403  fprintf( stdout,"spectrumCompute\n" );
3404  if( fast==0 ) fprintf( stdout," no optimization\n" );
3405  if( fast==1 ) fprintf( stdout," weight optimization\n" );
3406  if( fast==2 ) fprintf( stdout," symmetry optimization\n" );
3407  #endif
3408  #endif
3409  #endif
3410 
3411  // ----------------------
3412  // check if h is zero
3413  // ----------------------
3414 
3415  if( h==(poly)NULL )
3416  {
3417  return spectrumZero;
3418  }
3419 
3420  // ----------------------------------
3421  // check if h has a constant term
3422  // ----------------------------------
3423 
3424  if( hasConstTerm( h, currRing ) )
3425  {
3426  return spectrumBadPoly;
3427  }
3428 
3429  // --------------------------------
3430  // check if h has a linear term
3431  // --------------------------------
3432 
3433  if( hasLinearTerm( h, currRing ) )
3434  {
3435  *L = (lists)omAllocBin( slists_bin);
3436  (*L)->Init( 1 );
3437  (*L)->m[0].rtyp = INT_CMD; // milnor number
3438  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3439 
3440  return spectrumNoSingularity;
3441  }
3442 
3443  // ----------------------------------
3444  // compute the jacobi ideal of (h)
3445  // ----------------------------------
3446 
3447  ideal J = NULL;
3448  J = idInit( rVar(currRing),1 );
3449 
3450  #ifdef SPECTRUM_DEBUG
3451  #ifdef SPECTRUM_PRINT
3452  #ifdef SPECTRUM_IOSTREAM
3453  cout << "\n computing the Jacobi ideal...\n";
3454  #else
3455  fprintf( stdout,"\n computing the Jacobi ideal...\n" );
3456  #endif
3457  #endif
3458  #endif
3459 
3460  for( i=0; i<rVar(currRing); i++ )
3461  {
3462  J->m[i] = pDiff( h,i+1); //j );
3463 
3464  #ifdef SPECTRUM_DEBUG
3465  #ifdef SPECTRUM_PRINT
3466  #ifdef SPECTRUM_IOSTREAM
3467  cout << " ";
3468  #else
3469  fprintf( stdout," " );
3470  #endif
3471  pWrite( J->m[i] );
3472  #endif
3473  #endif
3474  }
3475 
3476  // --------------------------------------------
3477  // compute a standard basis stdJ of jac(h)
3478  // --------------------------------------------
3479 
3480  #ifdef SPECTRUM_DEBUG
3481  #ifdef SPECTRUM_PRINT
3482  #ifdef SPECTRUM_IOSTREAM
3483  cout << endl;
3484  cout << " computing a standard basis..." << endl;
3485  #else
3486  fprintf( stdout,"\n" );
3487  fprintf( stdout," computing a standard basis...\n" );
3488  #endif
3489  #endif
3490  #endif
3491 
3492  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3493  idSkipZeroes( stdJ );
3494 
3495  #ifdef SPECTRUM_DEBUG
3496  #ifdef SPECTRUM_PRINT
3497  for( i=0; i<IDELEMS(stdJ); i++ )
3498  {
3499  #ifdef SPECTRUM_IOSTREAM
3500  cout << " ";
3501  #else
3502  fprintf( stdout," " );
3503  #endif
3504 
3505  pWrite( stdJ->m[i] );
3506  }
3507  #endif
3508  #endif
3509 
3510  idDelete( &J );
3511 
3512  // ------------------------------------------
3513  // check if the h has a singularity
3514  // ------------------------------------------
3515 
3516  if( hasOne( stdJ, currRing ) )
3517  {
3518  // -------------------------------
3519  // h is smooth in the origin
3520  // return only the Milnor number
3521  // -------------------------------
3522 
3523  *L = (lists)omAllocBin( slists_bin);
3524  (*L)->Init( 1 );
3525  (*L)->m[0].rtyp = INT_CMD; // milnor number
3526  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3527 
3528  return spectrumNoSingularity;
3529  }
3530 
3531  // ------------------------------------------
3532  // check if the singularity h is isolated
3533  // ------------------------------------------
3534 
3535  for( i=rVar(currRing); i>0; i-- )
3536  {
3537  if( hasAxis( stdJ,i, currRing )==FALSE )
3538  {
3539  return spectrumNotIsolated;
3540  }
3541  }
3542 
3543  // ------------------------------------------
3544  // compute the highest corner hc of stdJ
3545  // ------------------------------------------
3546 
3547  #ifdef SPECTRUM_DEBUG
3548  #ifdef SPECTRUM_PRINT
3549  #ifdef SPECTRUM_IOSTREAM
3550  cout << "\n computing the highest corner...\n";
3551  #else
3552  fprintf( stdout,"\n computing the highest corner...\n" );
3553  #endif
3554  #endif
3555  #endif
3556 
3557  poly hc = (poly)NULL;
3558 
3559  scComputeHC( stdJ,currRing->qideal, 0,hc );
3560 
3561  if( hc!=(poly)NULL )
3562  {
3563  pGetCoeff(hc) = nInit(1);
3564 
3565  for( i=rVar(currRing); i>0; i-- )
3566  {
3567  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3568  }
3569  pSetm( hc );
3570  }
3571  else
3572  {
3573  return spectrumNoHC;
3574  }
3575 
3576  #ifdef SPECTRUM_DEBUG
3577  #ifdef SPECTRUM_PRINT
3578  #ifdef SPECTRUM_IOSTREAM
3579  cout << " ";
3580  #else
3581  fprintf( stdout," " );
3582  #endif
3583  pWrite( hc );
3584  #endif
3585  #endif
3586 
3587  // ----------------------------------------
3588  // compute the Newton polygon nph of h
3589  // ----------------------------------------
3590 
3591  #ifdef SPECTRUM_DEBUG
3592  #ifdef SPECTRUM_PRINT
3593  #ifdef SPECTRUM_IOSTREAM
3594  cout << "\n computing the newton polygon...\n";
3595  #else
3596  fprintf( stdout,"\n computing the newton polygon...\n" );
3597  #endif
3598  #endif
3599  #endif
3600 
3601  newtonPolygon nph( h, currRing );
3602 
3603  #ifdef SPECTRUM_DEBUG
3604  #ifdef SPECTRUM_PRINT
3605  cout << nph;
3606  #endif
3607  #endif
3608 
3609  // -----------------------------------------------
3610  // compute the weight corner wc of (stdj,nph)
3611  // -----------------------------------------------
3612 
3613  #ifdef SPECTRUM_DEBUG
3614  #ifdef SPECTRUM_PRINT
3615  #ifdef SPECTRUM_IOSTREAM
3616  cout << "\n computing the weight corner...\n";
3617  #else
3618  fprintf( stdout,"\n computing the weight corner...\n" );
3619  #endif
3620  #endif
3621  #endif
3622 
3623  poly wc = ( fast==0 ? pCopy( hc ) :
3624  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
3625  /* fast==2 */computeWC( nph,
3626  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
3627 
3628  #ifdef SPECTRUM_DEBUG
3629  #ifdef SPECTRUM_PRINT
3630  #ifdef SPECTRUM_IOSTREAM
3631  cout << " ";
3632  #else
3633  fprintf( stdout," " );
3634  #endif
3635  pWrite( wc );
3636  #endif
3637  #endif
3638 
3639  // -------------
3640  // compute NF
3641  // -------------
3642 
3643  #ifdef SPECTRUM_DEBUG
3644  #ifdef SPECTRUM_PRINT
3645  #ifdef SPECTRUM_IOSTREAM
3646  cout << "\n computing NF...\n" << endl;
3647  #else
3648  fprintf( stdout,"\n computing NF...\n" );
3649  #endif
3650  #endif
3651  #endif
3652 
3653  spectrumPolyList NF( &nph );
3654 
3655  computeNF( stdJ,hc,wc,&NF, currRing );
3656 
3657  #ifdef SPECTRUM_DEBUG
3658  #ifdef SPECTRUM_PRINT
3659  cout << NF;
3660  #ifdef SPECTRUM_IOSTREAM
3661  cout << endl;
3662  #else
3663  fprintf( stdout,"\n" );
3664  #endif
3665  #endif
3666  #endif
3667 
3668  // ----------------------------
3669  // compute the spectrum of h
3670  // ----------------------------
3671 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
3672 
3673  return spectrumStateFromList(NF, L, fast );
3674 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define pSetm(p)
Definition: polys.h:241
Definition: tok.h:85
#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:3150
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
void idDelete(ideal *h)
delete an ideal
Definition: ideals.h:31
#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 3765 of file ipshell.cc.

3766 {
3767  spectrumState state = spectrumOK;
3768 
3769  // -------------------
3770  // check consistency
3771  // -------------------
3772 
3773  // check for a local polynomial ring
3774 
3775  if( currRing->OrdSgn != -1 )
3776  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
3777  // or should we use:
3778  //if( !ringIsLocal( ) )
3779  {
3780  WerrorS( "only works for local orderings" );
3781  state = spectrumWrongRing;
3782  }
3783  else if( currRing->qideal != NULL )
3784  {
3785  WerrorS( "does not work in quotient rings" );
3786  state = spectrumWrongRing;
3787  }
3788  else
3789  {
3790  lists L = (lists)NULL;
3791  int flag = 2; // symmetric optimization
3792 
3793  state = spectrumCompute( (poly)first->Data( ),&L,flag );
3794 
3795  if( state==spectrumOK )
3796  {
3797  result->rtyp = LIST_CMD;
3798  result->data = (char*)L;
3799  }
3800  else
3801  {
3802  spectrumPrintError(state);
3803  }
3804  }
3805 
3806  return (state!=spectrumOK);
3807 }
spectrumState
Definition: ipshell.cc:3131
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:23
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:3683
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3391
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1097
Definition: tok.h:96
polyrec * poly
Definition: hilb.h:10
spectrum spectrumFromList ( lists  l)

Definition at line 2965 of file ipshell.cc.

2966 {
2967  spectrum result;
2968  copy_deep( result, l );
2969  return result;
2970 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:2941
return result
Definition: facAbsBiFact.cc:76
void spectrumPrintError ( spectrumState  state)

Definition at line 3683 of file ipshell.cc.

3684 {
3685  switch( state )
3686  {
3687  case spectrumZero:
3688  WerrorS( "polynomial is zero" );
3689  break;
3690  case spectrumBadPoly:
3691  WerrorS( "polynomial has constant term" );
3692  break;
3693  case spectrumNoSingularity:
3694  WerrorS( "not a singularity" );
3695  break;
3696  case spectrumNotIsolated:
3697  WerrorS( "the singularity is not isolated" );
3698  break;
3699  case spectrumNoHC:
3700  WerrorS( "highest corner cannot be computed" );
3701  break;
3702  case spectrumDegenerate:
3703  WerrorS( "principal part is degenerate" );
3704  break;
3705  case spectrumOK:
3706  break;
3707 
3708  default:
3709  WerrorS( "unknown error occurred" );
3710  break;
3711  }
3712 }
void WerrorS(const char *s)
Definition: feFopen.cc:23
BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 3714 of file ipshell.cc.

3715 {
3716  spectrumState state = spectrumOK;
3717 
3718  // -------------------
3719  // check consistency
3720  // -------------------
3721 
3722  // check for a local ring
3723 
3724  if( !ringIsLocal(currRing ) )
3725  {
3726  WerrorS( "only works for local orderings" );
3727  state = spectrumWrongRing;
3728  }
3729 
3730  // no quotient rings are allowed
3731 
3732  else if( currRing->qideal != NULL )
3733  {
3734  WerrorS( "does not work in quotient rings" );
3735  state = spectrumWrongRing;
3736  }
3737  else
3738  {
3739  lists L = (lists)NULL;
3740  int flag = 1; // weight corner optimization is safe
3741 
3742  state = spectrumCompute( (poly)first->Data( ),&L,flag );
3743 
3744  if( state==spectrumOK )
3745  {
3746  result->rtyp = LIST_CMD;
3747  result->data = (char*)L;
3748  }
3749  else
3750  {
3751  spectrumPrintError(state);
3752  }
3753  }
3754 
3755  return (state!=spectrumOK);
3756 }
spectrumState
Definition: ipshell.cc:3131
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:23
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:3683
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3391
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1097
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 3150 of file ipshell.cc.

3151 {
3152  spectrumPolyNode **node = &speclist.root;
3154 
3155  poly f,tmp;
3156  int found,cmp;
3157 
3158  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3159  ( fast==2 ? 2 : 1 ) );
3160 
3161  Rational weight_prev( 0,1 );
3162 
3163  int mu = 0; // the milnor number
3164  int pg = 0; // the geometrical genus
3165  int n = 0; // number of different spectral numbers
3166  int z = 0; // number of spectral number equal to smax
3167 
3168  while( (*node)!=(spectrumPolyNode*)NULL &&
3169  ( fast==0 || (*node)->weight<=smax ) )
3170  {
3171  // ---------------------------------------
3172  // determine the first normal form which
3173  // contains the monomial node->mon
3174  // ---------------------------------------
3175 
3176  found = FALSE;
3177  search = *node;
3178 
3179  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3180  {
3181  if( search->nf!=(poly)NULL )
3182  {
3183  f = search->nf;
3184 
3185  do
3186  {
3187  // --------------------------------
3188  // look for (*node)->mon in f
3189  // --------------------------------
3190 
3191  cmp = pCmp( (*node)->mon,f );
3192 
3193  if( cmp<0 )
3194  {
3195  f = pNext( f );
3196  }
3197  else if( cmp==0 )
3198  {
3199  // -----------------------------
3200  // we have found a normal form
3201  // -----------------------------
3202 
3203  found = TRUE;
3204 
3205  // normalize coefficient
3206 
3207  number inv = nInvers( pGetCoeff( f ) );
3208  pMult_nn( search->nf,inv );
3209  nDelete( &inv );
3210 
3211  // exchange normal forms
3212 
3213  tmp = (*node)->nf;
3214  (*node)->nf = search->nf;
3215  search->nf = tmp;
3216  }
3217  }
3218  while( cmp<0 && f!=(poly)NULL );
3219  }
3220  search = search->next;
3221  }
3222 
3223  if( found==FALSE )
3224  {
3225  // ------------------------------------------------
3226  // the weight of node->mon is a spectrum number
3227  // ------------------------------------------------
3228 
3229  mu++;
3230 
3231  if( (*node)->weight<=(Rational)1 ) pg++;
3232  if( (*node)->weight==smax ) z++;
3233  if( (*node)->weight>weight_prev ) n++;
3234 
3235  weight_prev = (*node)->weight;
3236  node = &((*node)->next);
3237  }
3238  else
3239  {
3240  // -----------------------------------------------
3241  // determine all other normal form which contain
3242  // the monomial node->mon
3243  // replace for node->mon its normal form
3244  // -----------------------------------------------
3245 
3246  while( search!=(spectrumPolyNode*)NULL )
3247  {
3248  if( search->nf!=(poly)NULL )
3249  {
3250  f = search->nf;
3251 
3252  do
3253  {
3254  // --------------------------------
3255  // look for (*node)->mon in f
3256  // --------------------------------
3257 
3258  cmp = pCmp( (*node)->mon,f );
3259 
3260  if( cmp<0 )
3261  {
3262  f = pNext( f );
3263  }
3264  else if( cmp==0 )
3265  {
3266  search->nf = pSub( search->nf,
3267  ppMult_nn( (*node)->nf,pGetCoeff( f ) ) );
3268  pNorm( search->nf );
3269  }
3270  }
3271  while( cmp<0 && f!=(poly)NULL );
3272  }
3273  search = search->next;
3274  }
3275  speclist.delete_node( node );
3276  }
3277 
3278  }
3279 
3280  // --------------------------------------------------------
3281  // fast computation exploits the symmetry of the spectrum
3282  // --------------------------------------------------------
3283 
3284  if( fast==2 )
3285  {
3286  mu = 2*mu - z;
3287  n = ( z > 0 ? 2*n - 1 : 2*n );
3288  }
3289 
3290  // --------------------------------------------------------
3291  // compute the spectrum numbers with their multiplicities
3292  // --------------------------------------------------------
3293 
3294  intvec *nom = new intvec( n );
3295  intvec *den = new intvec( n );
3296  intvec *mult = new intvec( n );
3297 
3298  int count = 0;
3299  int multiplicity = 1;
3300 
3301  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3302  ( fast==0 || search->weight<=smax );
3303  search=search->next )
3304  {
3305  if( search->next==(spectrumPolyNode*)NULL ||
3306  search->weight<search->next->weight )
3307  {
3308  (*nom) [count] = search->weight.get_num_si( );
3309  (*den) [count] = search->weight.get_den_si( );
3310  (*mult)[count] = multiplicity;
3311 
3312  multiplicity=1;
3313  count++;
3314  }
3315  else
3316  {
3317  multiplicity++;
3318  }
3319  }
3320 
3321  // --------------------------------------------------------
3322  // fast computation exploits the symmetry of the spectrum
3323  // --------------------------------------------------------
3324 
3325  if( fast==2 )
3326  {
3327  int n1,n2;
3328  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3329  {
3330  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3331  (*den) [n2] = (*den)[n1];
3332  (*mult)[n2] = (*mult)[n1];
3333  }
3334  }
3335 
3336  // -----------------------------------
3337  // test if the spectrum is symmetric
3338  // -----------------------------------
3339 
3340  if( fast==0 || fast==1 )
3341  {
3342  int symmetric=TRUE;
3343 
3344  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3345  {
3346  if( (*mult)[n1]!=(*mult)[n2] ||
3347  (*den) [n1]!= (*den)[n2] ||
3348  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3349  {
3350  symmetric = FALSE;
3351  }
3352  }
3353 
3354  if( symmetric==FALSE )
3355  {
3356  // ---------------------------------------------
3357  // the spectrum is not symmetric => degenerate
3358  // principal part
3359  // ---------------------------------------------
3360 
3361  *L = (lists)omAllocBin( slists_bin);
3362  (*L)->Init( 1 );
3363  (*L)->m[0].rtyp = INT_CMD; // milnor number
3364  (*L)->m[0].data = (void*)(long)mu;
3365 
3366  return spectrumDegenerate;
3367  }
3368  }
3369 
3370  *L = (lists)omAllocBin( slists_bin);
3371 
3372  (*L)->Init( 6 );
3373 
3374  (*L)->m[0].rtyp = INT_CMD; // milnor number
3375  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3376  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3377  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3378  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3379  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3380 
3381  (*L)->m[0].data = (void*)(long)mu;
3382  (*L)->m[1].data = (void*)(long)pg;
3383  (*L)->m[2].data = (void*)(long)n;
3384  (*L)->m[3].data = (void*)nom;
3385  (*L)->m[4].data = (void*)den;
3386  (*L)->m[5].data = (void*)mult;
3387 
3388  return spectrumOK;
3389 }
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
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
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
FILE * f
Definition: checklibs.c:7
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 4051 of file ipshell.cc.

4052 {
4053  semicState state;
4054 
4055  // -----------------
4056  // check arguments
4057  // -----------------
4058 
4059  lists l = (lists)first->Data( );
4060  int k = (int)(long)second->Data( );
4061 
4062  if( (state=list_is_spectrum( l ))!=semicOK )
4063  {
4064  WerrorS( "first argument is not a spectrum" );
4065  list_error( state );
4066  }
4067  else if( k < 0 )
4068  {
4069  WerrorS( "second argument should be positive" );
4070  state = semicMulNegative;
4071  }
4072  else
4073  {
4074  spectrum s= spectrumFromList( l );
4075  spectrum product( k*s );
4076 
4077  result->rtyp = LIST_CMD;
4078  result->data = (char*)getList(product);
4079  }
4080 
4081  return (state!=semicOK);
4082 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:2965
void list_error(semicState state)
Definition: ipshell.cc:3049
void WerrorS(const char *s)
Definition: feFopen.cc:23
int k
Definition: cfEzgcd.cc:93
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:2977
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:3834
semicState
Definition: ipshell.cc:3015
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1097
Definition: tok.h:96
int l
Definition: cfEzgcd.cc:94
BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 2748 of file ipshell.cc.

2749 {
2750  sleftv tmp;
2751  memset(&tmp,0,sizeof(tmp));
2752  tmp.rtyp=INT_CMD;
2753  tmp.data=(void *)1;
2754  return syBetti2(res,u,&tmp);
2755 }
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:2725
int rtyp
Definition: subexpr.h:92
BOOLEAN syBetti2 ( leftv  res,
leftv  u,
leftv  w 
)

Definition at line 2725 of file ipshell.cc.

2726 {
2727  syStrategy syzstr=(syStrategy)u->Data();
2728 
2729  BOOLEAN minim=(int)(long)w->Data();
2730  int row_shift=0;
2731  int add_row_shift=0;
2732  intvec *weights=NULL;
2733  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2734  if (ww!=NULL)
2735  {
2736  weights=ivCopy(ww);
2737  add_row_shift = ww->min_in();
2738  (*weights) -= add_row_shift;
2739  }
2740 
2741  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
2742  //row_shift += add_row_shift;
2743  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
2744  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
2745 
2746  return FALSE;
2747 }
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:137
int min_in()
Definition: intvec.h:110
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:1097
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 2836 of file ipshell.cc.

2837 {
2838  int typ0;
2840 
2841  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
2842  if (fr != NULL)
2843  {
2844 
2845  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
2846  for (int i=result->length-1;i>=0;i--)
2847  {
2848  if (fr[i]!=NULL)
2849  result->fullres[i] = idCopy(fr[i]);
2850  }
2851  result->list_length=result->length;
2852  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
2853  }
2854  else
2855  {
2856  omFreeSize(result, sizeof(ssyStrategy));
2857  result = NULL;
2858  }
2859  if (toDel) li->Clean();
2860  return result;
2861 }
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:76
#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 2760 of file ipshell.cc.

2761 {
2762  resolvente fullres = syzstr->fullres;
2763  resolvente minres = syzstr->minres;
2764 
2765  const int length = syzstr->length;
2766 
2767  if ((fullres==NULL) && (minres==NULL))
2768  {
2769  if (syzstr->hilb_coeffs==NULL)
2770  { // La Scala
2771  fullres = syReorder(syzstr->res, length, syzstr);
2772  }
2773  else
2774  { // HRES
2775  minres = syReorder(syzstr->orderedRes, length, syzstr);
2776  syKillEmptyEntres(minres, length);
2777  }
2778  }
2779 
2780  resolvente tr;
2781  int typ0=IDEAL_CMD;
2782 
2783  if (minres!=NULL)
2784  tr = minres;
2785  else
2786  tr = fullres;
2787 
2788  resolvente trueres=NULL; intvec ** w=NULL;
2789 
2790  if (length>0)
2791  {
2792  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
2793  for (int i=(length)-1;i>=0;i--)
2794  {
2795  if (tr[i]!=NULL)
2796  {
2797  trueres[i] = idCopy(tr[i]);
2798  }
2799  }
2800  if ( id_RankFreeModule(trueres[0], currRing) > 0)
2801  typ0 = MODUL_CMD;
2802  if (syzstr->weights!=NULL)
2803  {
2804  w = (intvec**)omAlloc0(length*sizeof(intvec*));
2805  for (int i=length-1;i>=0;i--)
2806  {
2807  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
2808  }
2809  }
2810  }
2811 
2812  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
2813  w, add_row_shift);
2814 
2815  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
2816 
2817  if (toDel)
2818  syKillComputation(syzstr);
2819  else
2820  {
2821  if( fullres != NULL && syzstr->fullres == NULL )
2822  syzstr->fullres = fullres;
2823 
2824  if( minres != NULL && syzstr->minres == NULL )
2825  syzstr->minres = minres;
2826  }
2827 
2828  return li;
2829 
2830 
2831 }
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:137
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:76
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 2866 of file ipshell.cc.

2867 {
2868  int typ0;
2870 
2871  resolvente fr = liFindRes(li,&(result->length),&typ0);
2872  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
2873  for (int i=result->length-1;i>=0;i--)
2874  {
2875  if (fr[i]!=NULL)
2876  result->minres[i] = idCopy(fr[i]);
2877  }
2878  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
2879  return result;
2880 }
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:76
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 514 of file ipshell.cc.

515 {
516  int ii;
517 
518  if (i<0)
519  {
520  ii= -i;
521  if (ii < 32)
522  {
523  si_opt_1 &= ~Sy_bit(ii);
524  }
525  else if (ii < 64)
526  {
527  si_opt_2 &= ~Sy_bit(ii-32);
528  }
529  else
530  WerrorS("out of bounds\n");
531  }
532  else if (i<32)
533  {
534  ii=i;
535  if (Sy_bit(ii) & kOptions)
536  {
537  Warn("Gerhard, use the option command");
538  si_opt_1 |= Sy_bit(ii);
539  }
540  else if (Sy_bit(ii) & validOpts)
541  si_opt_1 |= Sy_bit(ii);
542  }
543  else if (i<64)
544  {
545  ii=i-32;
546  si_opt_2 |= Sy_bit(ii);
547  }
548  else
549  WerrorS("out of bounds\n");
550 }
unsigned si_opt_1
Definition: options.c:5
void WerrorS(const char *s)
Definition: feFopen.cc:23
#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:322
#define Print
Definition: emacs.cc:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
int Typ()
Definition: subexpr.cc:955
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:1097
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 972 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 5166 of file ipshell.cc.