My Project
Macros | Enumerations | Functions | Variables
ipshell.cc File Reference
#include "kernel/mod2.h"
#include "factory/factory.h"
#include "misc/options.h"
#include "misc/mylimits.h"
#include "misc/intvec.h"
#include "misc/prime.h"
#include "coeffs/numbers.h"
#include "coeffs/coeffs.h"
#include "coeffs/rmodulon.h"
#include "coeffs/longrat.h"
#include "polys/monomials/p_polys.h"
#include "polys/monomials/ring.h"
#include "polys/monomials/maps.h"
#include "polys/prCopy.h"
#include "polys/matpol.h"
#include "polys/shiftop.h"
#include "polys/weight.h"
#include "polys/clapsing.h"
#include "polys/ext_fields/algext.h"
#include "polys/ext_fields/transext.h"
#include "kernel/polys.h"
#include "kernel/ideals.h"
#include "kernel/numeric/mpr_base.h"
#include "kernel/numeric/mpr_numeric.h"
#include "kernel/GBEngine/syz.h"
#include "kernel/GBEngine/kstd1.h"
#include "kernel/GBEngine/kutil.h"
#include "kernel/combinatorics/stairc.h"
#include "kernel/combinatorics/hutil.h"
#include "kernel/spectrum/semic.h"
#include "kernel/spectrum/splist.h"
#include "kernel/spectrum/spectrum.h"
#include "kernel/oswrapper/feread.h"
#include "Singular/lists.h"
#include "Singular/attrib.h"
#include "Singular/ipconv.h"
#include "Singular/links/silink.h"
#include "Singular/ipshell.h"
#include "Singular/maps_ip.h"
#include "Singular/tok.h"
#include "Singular/ipid.h"
#include "Singular/subexpr.h"
#include "Singular/fevoices.h"
#include "Singular/sdb.h"
#include <cmath>
#include <ctype.h>
#include "kernel/maps/gen_maps.h"
#include "libparse.h"

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

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

Functions

const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
static void list1 (const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
 
void type_cmd (leftv v)
 
static void killlocals0 (int v, idhdl *localhdl, const ring r)
 
void killlocals_rec (idhdl *root, int v, ring r)
 
BOOLEAN killlocals_list (int v, lists L)
 
void killlocals (int v)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
 
void test_cmd (int i)
 
int exprlist_length (leftv v)
 
BOOLEAN iiWRITE (leftv, leftv v)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
 
static resolvente iiCopyRes (resolvente r, int l)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv u)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
int iiRegularity (lists L)
 
void iiDebug ()
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
 
BOOLEAN iiDefaultParameter (leftv p)
 
BOOLEAN iiBranchTo (leftv, leftv args)
 
BOOLEAN iiParameter (leftv p)
 
static BOOLEAN iiInternalExport (leftv v, int toLev)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package rootpack)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal I, int ak)
 
void iiCheckPack (package &p)
 
idhdl rDefault (const char *s)
 
static idhdl rSimpleFindHdl (const ring r, const idhdl root, const idhdl n)
 
idhdl rFindHdl (ring r, idhdl n)
 
void rDecomposeCF (leftv h, const ring r, const ring R)
 
static void rDecomposeC_41 (leftv h, const coeffs C)
 
static void rDecomposeC (leftv h, const ring R)
 
void rDecomposeRing_41 (leftv h, const coeffs C)
 
void rDecomposeRing (leftv h, const ring R)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 
static void rDecompose_23456 (const ring r, lists L)
 
lists rDecompose_list_cf (const ring r)
 
lists rDecompose (const ring r)
 
void rComposeC (lists L, ring R)
 
void rComposeRing (lists L, ring R)
 
static void rRenameVars (ring R)
 
static BOOLEAN rComposeVar (const lists L, ring R)
 
static BOOLEAN rComposeOrder (const lists L, const BOOLEAN check_comp, ring R)
 
ring rCompose (const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
 
BOOLEAN mpJacobi (leftv res, leftv a)
 
BOOLEAN mpKoszul (leftv res, leftv c, leftv b, leftv id)
 
BOOLEAN syBetti2 (leftv res, leftv u, leftv w)
 
BOOLEAN syBetti1 (leftv res, leftv u)
 
lists syConvRes (syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
 
syStrategy syConvList (lists li)
 
syStrategy syForceMin (lists li)
 
BOOLEAN kWeight (leftv res, leftv id)
 
BOOLEAN kQHWeight (leftv res, leftv v)
 
BOOLEAN jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN jjCHARSERIES (leftv res, leftv u)
 
void copy_deep (spectrum &spec, lists l)
 
spectrum spectrumFromList (lists l)
 
lists getList (spectrum &spec)
 
void list_error (semicState state)
 
spectrumState spectrumStateFromList (spectrumPolyList &speclist, lists *L, int fast)
 
spectrumState spectrumCompute (poly h, lists *L, int fast)
 
void spectrumPrintError (spectrumState state)
 
BOOLEAN spectrumProc (leftv result, leftv first)
 
BOOLEAN spectrumfProc (leftv result, leftv first)
 
semicState list_is_spectrum (lists l)
 
BOOLEAN spaddProc (leftv result, leftv first, leftv second)
 
BOOLEAN spmulProc (leftv result, leftv first, leftv second)
 
BOOLEAN semicProc3 (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN semicProc (leftv res, leftv u, leftv v)
 
BOOLEAN loNewtonP (leftv res, leftv arg1)
 compute Newton Polytopes of input polynomials More...
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm. More...
 
BOOLEAN nuMPResMat (leftv res, leftv arg1, leftv arg2)
 returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) More...
 
BOOLEAN nuLagSolve (leftv res, leftv arg1, leftv arg2, leftv arg3)
 find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver. More...
 
BOOLEAN nuVanderSys (leftv res, leftv arg1, leftv arg2, leftv arg3)
 COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d. More...
 
BOOLEAN nuUResSolve (leftv res, leftv args)
 solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal). More...
 
lists listOfRoots (rootArranger *self, const unsigned int oprec)
 
void rSetHdl (idhdl h)
 
static leftv rOptimizeOrdAsSleftv (leftv ord)
 
BOOLEAN rSleftvOrdering2Ordering (sleftv *ord, ring R)
 
static BOOLEAN rSleftvList2StringArray (leftv sl, char **p)
 
ring rInit (leftv pn, leftv rv, leftv ord)
 
ring rSubring (ring org_ring, sleftv *rv)
 
void rKill (ring r)
 
void rKill (idhdl h)
 
BOOLEAN jjPROC (leftv res, leftv u, leftv v)
 
static void jjINT_S_TO_ID (int n, int *e, leftv res)
 
BOOLEAN jjVARIABLES_P (leftv res, leftv u)
 
BOOLEAN jjVARIABLES_ID (leftv res, leftv u)
 
void paPrint (const char *n, package p)
 
BOOLEAN iiApplyINTVEC (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiApplyBIGINTMAT (leftv, leftv, int, leftv)
 
BOOLEAN iiApplyIDEAL (leftv, leftv, int, leftv)
 
BOOLEAN iiApplyLIST (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiApply (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiTestAssume (leftv a, leftv b)
 
BOOLEAN iiARROW (leftv r, char *a, char *s)
 
BOOLEAN iiAssignCR (leftv r, leftv arg)
 
static void iiReportTypes (int nr, int t, const short *T)
 
BOOLEAN iiCheckTypes (leftv args, const short *type_list, int report)
 check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise More...
 
void iiSetReturn (const leftv source)
 

Variables

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

Macro Definition Documentation

◆ BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH   80

Definition at line 1064 of file ipshell.cc.

Enumeration Type Documentation

◆ semicState

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

Definition at line 3433 of file ipshell.cc.

3434 {
3435  semicOK,
3437 
3440 
3447 
3452 
3458 
3461 
3464 
3465 } semicState;
semicState
Definition: ipshell.cc:3434
@ semicListWrongNumberOfNumerators
Definition: ipshell.cc:3449
@ semicListPGWrong
Definition: ipshell.cc:3463
@ semicListFirstElementWrongType
Definition: ipshell.cc:3441
@ semicListPgNegative
Definition: ipshell.cc:3454
@ semicListSecondElementWrongType
Definition: ipshell.cc:3442
@ semicListMilnorWrong
Definition: ipshell.cc:3462
@ semicListMulNegative
Definition: ipshell.cc:3457
@ semicListFourthElementWrongType
Definition: ipshell.cc:3444
@ semicListWrongNumberOfDenominators
Definition: ipshell.cc:3450
@ semicListNotMonotonous
Definition: ipshell.cc:3460
@ semicListNotSymmetric
Definition: ipshell.cc:3459
@ semicListNNegative
Definition: ipshell.cc:3448
@ semicListDenNegative
Definition: ipshell.cc:3456
@ semicListTooShort
Definition: ipshell.cc:3438
@ semicListTooLong
Definition: ipshell.cc:3439
@ semicListThirdElementWrongType
Definition: ipshell.cc:3443
@ semicListMuNegative
Definition: ipshell.cc:3453
@ semicListNumNegative
Definition: ipshell.cc:3455
@ semicMulNegative
Definition: ipshell.cc:3436
@ semicListWrongNumberOfMultiplicities
Definition: ipshell.cc:3451
@ semicOK
Definition: ipshell.cc:3435
@ semicListFifthElementWrongType
Definition: ipshell.cc:3445
@ semicListSixthElementWrongType
Definition: ipshell.cc:3446

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3549 of file ipshell.cc.

3550 {
3551  spectrumOK,
3552  spectrumZero,
3558  spectrumNoHC,
3560 };
@ spectrumWrongRing
Definition: ipshell.cc:3557
@ spectrumOK
Definition: ipshell.cc:3551
@ spectrumDegenerate
Definition: ipshell.cc:3556
@ spectrumUnspecErr
Definition: ipshell.cc:3559
@ spectrumNotIsolated
Definition: ipshell.cc:3555
@ spectrumBadPoly
Definition: ipshell.cc:3553
@ spectrumNoSingularity
Definition: ipshell.cc:3554
@ spectrumZero
Definition: ipshell.cc:3552
@ spectrumNoHC
Definition: ipshell.cc:3558

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3359 of file ipshell.cc.

3360 {
3361  spec.mu = (int)(long)(l->m[0].Data( ));
3362  spec.pg = (int)(long)(l->m[1].Data( ));
3363  spec.n = (int)(long)(l->m[2].Data( ));
3364 
3365  spec.copy_new( spec.n );
3366 
3367  intvec *num = (intvec*)l->m[3].Data( );
3368  intvec *den = (intvec*)l->m[4].Data( );
3369  intvec *mul = (intvec*)l->m[5].Data( );
3370 
3371  for( int i=0; i<spec.n; i++ )
3372  {
3373  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3374  spec.w[i] = (*mul)[i];
3375  }
3376 }
CanonicalForm num(const CanonicalForm &f)
CanonicalForm den(const CanonicalForm &f)
int l
Definition: cfEzgcd.cc:100
int i
Definition: cfEzgcd.cc:132
Definition: intvec.h:23
int mu
Definition: semic.h:67
void copy_new(int)
Definition: semic.cc:54
Rational * s
Definition: semic.h:70
int n
Definition: semic.h:69
int pg
Definition: semic.h:68
int * w
Definition: semic.h:71

◆ exprlist_length()

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 }
Variable next() const
Definition: factory.h:146
int & rows()
Definition: matpol.h:23
int & cols()
Definition: matpol.h:24
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:39
@ IDEAL_CMD
Definition: grammar.cc:284
@ MATRIX_CMD
Definition: grammar.cc:286
@ INTMAT_CMD
Definition: grammar.cc:279
@ MODUL_CMD
Definition: grammar.cc:287
@ VECTOR_CMD
Definition: grammar.cc:292
@ NUMBER_CMD
Definition: grammar.cc:288
@ POLY_CMD
Definition: grammar.cc:289
ip_smatrix * matrix
Definition: matpol.h:43
slists * lists
Definition: mpr_numeric.h:146
#define NULL
Definition: omList.c:12
@ LIST_CMD
Definition: tok.h:118
@ INTVEC_CMD
Definition: tok.h:101
@ INT_CMD
Definition: tok.h:96

◆ getList()

lists getList ( spectrum spec)

Definition at line 3395 of file ipshell.cc.

3396 {
3398 
3399  L->Init( 6 );
3400 
3401  intvec *num = new intvec( spec.n );
3402  intvec *den = new intvec( spec.n );
3403  intvec *mult = new intvec( spec.n );
3404 
3405  for( int i=0; i<spec.n; i++ )
3406  {
3407  (*num) [i] = spec.s[i].get_num_si( );
3408  (*den) [i] = spec.s[i].get_den_si( );
3409  (*mult)[i] = spec.w[i];
3410  }
3411 
3412  L->m[0].rtyp = INT_CMD; // milnor number
3413  L->m[1].rtyp = INT_CMD; // geometrical genus
3414  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3415  L->m[3].rtyp = INTVEC_CMD; // numerators
3416  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3417  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3418 
3419  L->m[0].data = (void*)(long)spec.mu;
3420  L->m[1].data = (void*)(long)spec.pg;
3421  L->m[2].data = (void*)(long)spec.n;
3422  L->m[3].data = (void*)num;
3423  L->m[4].data = (void*)den;
3424  L->m[5].data = (void*)mult;
3425 
3426  return L;
3427 }
int get_num_si()
Definition: GMPrat.cc:138
int get_den_si()
Definition: GMPrat.cc:152
int rtyp
Definition: subexpr.h:91
void * data
Definition: subexpr.h:88
Definition: lists.h:24
sleftv * m
Definition: lists.h:46
INLINE_THIS void Init(int l=0)
VAR omBin slists_bin
Definition: lists.cc:23
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:647
#define omAllocBin(bin)
Definition: omAllocDecl.h:205

◆ iiApply()

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

Definition at line 6421 of file ipshell.cc.

6422 {
6423  res->Init();
6424  res->rtyp=a->Typ();
6425  switch (res->rtyp /*a->Typ()*/)
6426  {
6427  case INTVEC_CMD:
6428  case INTMAT_CMD:
6429  return iiApplyINTVEC(res,a,op,proc);
6430  case BIGINTMAT_CMD:
6431  return iiApplyBIGINTMAT(res,a,op,proc);
6432  case IDEAL_CMD:
6433  case MODUL_CMD:
6434  case MATRIX_CMD:
6435  return iiApplyIDEAL(res,a,op,proc);
6436  case LIST_CMD:
6437  return iiApplyLIST(res,a,op,proc);
6438  }
6439  WerrorS("first argument to `apply` must allow an index");
6440  return TRUE;
6441 }
#define TRUE
Definition: auxiliary.h:100
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
int Typ()
Definition: subexpr.cc:1011
CanonicalForm res
Definition: facAbsFact.cc:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
@ BIGINTMAT_CMD
Definition: grammar.cc:278
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6340
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6382
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6377
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6372

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6372 of file ipshell.cc.

6373 {
6374  WerrorS("not implemented");
6375  return TRUE;
6376 }

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6377 of file ipshell.cc.

6378 {
6379  WerrorS("not implemented");
6380  return TRUE;
6381 }

◆ iiApplyINTVEC()

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

Definition at line 6340 of file ipshell.cc.

6341 {
6342  intvec *aa=(intvec*)a->Data();
6343  sleftv tmp_out;
6344  sleftv tmp_in;
6345  leftv curr=res;
6346  BOOLEAN bo=FALSE;
6347  for(int i=0;i<aa->length(); i++)
6348  {
6349  tmp_in.Init();
6350  tmp_in.rtyp=INT_CMD;
6351  tmp_in.data=(void*)(long)(*aa)[i];
6352  if (proc==NULL)
6353  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6354  else
6355  bo=jjPROC(&tmp_out,proc,&tmp_in);
6356  if (bo)
6357  {
6358  res->CleanUp(currRing);
6359  Werror("apply fails at index %d",i+1);
6360  return TRUE;
6361  }
6362  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6363  else
6364  {
6365  curr->next=(leftv)omAllocBin(sleftv_bin);
6366  curr=curr->next;
6367  memcpy(curr,&tmp_out,sizeof(tmp_out));
6368  }
6369  }
6370  return FALSE;
6371 }
int BOOLEAN
Definition: auxiliary.h:87
#define FALSE
Definition: auxiliary.h:96
int length() const
Definition: intvec.h:94
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void * Data()
Definition: subexpr.cc:1154
void Init()
Definition: subexpr.h:107
leftv next
Definition: subexpr.h:86
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:9091
EXTERN_VAR omBin sleftv_bin
Definition: ipid.h:145
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1619
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void Werror(const char *fmt,...)
Definition: reporter.cc:189
sleftv * leftv
Definition: structs.h:57

◆ iiApplyLIST()

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

Definition at line 6382 of file ipshell.cc.

6383 {
6384  lists aa=(lists)a->Data();
6385  if (aa->nr==-1) /* empty list*/
6386  {
6388  l->Init();
6389  res->data=(void *)l;
6390  return FALSE;
6391  }
6392  sleftv tmp_out;
6393  sleftv tmp_in;
6394  leftv curr=res;
6395  BOOLEAN bo=FALSE;
6396  for(int i=0;i<=aa->nr; i++)
6397  {
6398  tmp_in.Init();
6399  tmp_in.Copy(&(aa->m[i]));
6400  if (proc==NULL)
6401  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6402  else
6403  bo=jjPROC(&tmp_out,proc,&tmp_in);
6404  tmp_in.CleanUp();
6405  if (bo)
6406  {
6407  res->CleanUp(currRing);
6408  Werror("apply fails at index %d",i+1);
6409  return TRUE;
6410  }
6411  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6412  else
6413  {
6414  curr->next=(leftv)omAllocBin(sleftv_bin);
6415  curr=curr->next;
6416  memcpy(curr,&tmp_out,sizeof(tmp_out));
6417  }
6418  }
6419  return FALSE;
6420 }
void Copy(leftv e)
Definition: subexpr.cc:685
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
int nr
Definition: lists.h:44

◆ iiARROW()

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

Definition at line 6470 of file ipshell.cc.

6471 {
6472  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6473  // find end of s:
6474  int end_s=strlen(s);
6475  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6476  s[end_s+1]='\0';
6477  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6478  sprintf(name,"%s->%s",a,s);
6479  // find start of last expression
6480  int start_s=end_s-1;
6481  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6482  if (start_s<0) // ';' not found
6483  {
6484  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6485  }
6486  else // s[start_s] is ';'
6487  {
6488  s[start_s]='\0';
6489  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6490  }
6491  r->Init();
6492  // now produce procinfo for PROC_CMD:
6493  r->data = (void *)omAlloc0Bin(procinfo_bin);
6494  ((procinfo *)(r->data))->language=LANG_NONE;
6495  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6496  ((procinfo *)r->data)->data.s.body=ss;
6497  omFree(name);
6498  r->rtyp=PROC_CMD;
6499  //r->rtyp=STRING_CMD;
6500  //r->data=ss;
6501  return FALSE;
6502 }
const CanonicalForm int s
Definition: facAbsFact.cc:51
char name(const Variable &v)
Definition: factory.h:189
@ PROC_CMD
Definition: grammar.cc:280
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:1049
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define omFree(addr)
Definition: omAllocDecl.h:261
VAR omBin procinfo_bin
Definition: subexpr.cc:42
@ LANG_NONE
Definition: subexpr.h:22

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6504 of file ipshell.cc.

6505 {
6506  char* ring_name=omStrDup((char*)r->Name());
6507  int t=arg->Typ();
6508  if (t==RING_CMD)
6509  {
6510  sleftv tmp;
6511  tmp.Init();
6512  tmp.rtyp=IDHDL;
6513  idhdl h=rDefault(ring_name);
6514  tmp.data=(char*)h;
6515  if (h!=NULL)
6516  {
6517  tmp.name=h->id;
6518  BOOLEAN b=iiAssign(&tmp,arg);
6519  if (b) return TRUE;
6520  rSetHdl(ggetid(ring_name));
6521  omFree(ring_name);
6522  return FALSE;
6523  }
6524  else
6525  return TRUE;
6526  }
6527  else if (t==CRING_CMD)
6528  {
6529  sleftv tmp;
6530  sleftv n;
6531  n.Init();
6532  n.name=ring_name;
6533  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6534  if (iiAssign(&tmp,arg)) return TRUE;
6535  //Print("create %s\n",r->Name());
6536  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6537  return FALSE;
6538  }
6539  //Print("create %s\n",r->Name());
6540  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6541  return TRUE;// not handled -> error for now
6542 }
CanonicalForm b
Definition: cfModGcd.cc:4103
Definition: idrec.h:35
const char * name
Definition: subexpr.h:87
const char * Name()
Definition: subexpr.h:120
VAR int myynest
Definition: febase.cc:41
@ RING_CMD
Definition: grammar.cc:281
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1963
idhdl ggetid(const char *n)
Definition: ipid.cc:581
#define IDROOT
Definition: ipid.h:19
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1198
idhdl rDefault(const char *s)
Definition: ipshell.cc:1644
void rSetHdl(idhdl h)
Definition: ipshell.cc:5125
STATIC_VAR Poly * h
Definition: janet.cc:971
#define omStrDup(s)
Definition: omAllocDecl.h:263
#define IDHDL
Definition: tok.h:31
@ CRING_CMD
Definition: tok.h:56

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1273 of file ipshell.cc.

1274 {
1275  // must be inside a proc, as we simultae an proc_end at the end
1276  if (myynest==0)
1277  {
1278  WerrorS("branchTo can only occur in a proc");
1279  return TRUE;
1280  }
1281  // <string1...stringN>,<proc>
1282  // known: args!=NULL, l>=1
1283  int l=args->listLength();
1284  int ll=0;
1285  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1286  if (ll!=(l-1)) return FALSE;
1287  leftv h=args;
1288  // set up the table for type test:
1289  short *t=(short*)omAlloc(l*sizeof(short));
1290  t[0]=l-1;
1291  int b;
1292  int i;
1293  for(i=1;i<l;i++,h=h->next)
1294  {
1295  if (h->Typ()!=STRING_CMD)
1296  {
1297  omFreeBinAddr(t);
1298  Werror("arg %d is not a string",i);
1299  return TRUE;
1300  }
1301  int tt;
1302  b=IsCmd((char *)h->Data(),tt);
1303  if(b) t[i]=tt;
1304  else
1305  {
1306  omFreeBinAddr(t);
1307  Werror("arg %d is not a type name",i);
1308  return TRUE;
1309  }
1310  }
1311  if (h->Typ()!=PROC_CMD)
1312  {
1313  omFreeBinAddr(t);
1314  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1315  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1316  return TRUE;
1317  }
1318  b=iiCheckTypes(iiCurrArgs,t,0);
1319  omFreeBinAddr(t);
1320  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1321  {
1322  // get the proc:
1323  iiCurrProc=(idhdl)h->data;
1324  idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1325  procinfo * pi=IDPROC(currProc);
1326  // already loaded ?
1327  if( pi->data.s.body==NULL )
1328  {
1330  if (pi->data.s.body==NULL) return TRUE;
1331  }
1332  // set currPackHdl/currPack
1333  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1334  {
1335  currPack=pi->pack;
1338  //Print("set pack=%s\n",IDID(currPackHdl));
1339  }
1340  // see iiAllStart:
1341  BITSET save1=si_opt_1;
1342  BITSET save2=si_opt_2;
1343  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1344  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1345  BOOLEAN err=yyparse();
1346  iiCurrProc=NULL;
1347  si_opt_1=save1;
1348  si_opt_2=save2;
1349  // now save the return-expr.
1351  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1352  iiRETURNEXPR.Init();
1353  // warning about args.:
1354  if (iiCurrArgs!=NULL)
1355  {
1356  if (err==0) Warn("too many arguments for %s",IDID(currProc));
1357  iiCurrArgs->CleanUp();
1359  iiCurrArgs=NULL;
1360  }
1361  // similate proc_end:
1362  // - leave input
1363  void myychangebuffer();
1364  myychangebuffer();
1365  // - set the current buffer to its end (this is a pointer in a buffer,
1366  // not a file ptr) "branchTo" is only valid in proc)
1368  // - kill local vars
1370  // - return
1371  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1372  return (err!=0);
1373  }
1374  return FALSE;
1375 }
void * ADDRESS
Definition: auxiliary.h:119
char * buffer
Definition: fevoices.h:69
long fptr
Definition: fevoices.h:70
int listLength()
Definition: subexpr.cc:51
#define Warn
Definition: emacs.cc:77
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:166
VAR Voice * currentVoice
Definition: fevoices.cc:49
@ BT_execute
Definition: fevoices.h:23
@ BT_proc
Definition: fevoices.h:20
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
int yyparse(void)
Definition: grammar.cc:2111
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:9501
VAR package currPack
Definition: ipid.cc:57
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:831
#define IDPROC(a)
Definition: ipid.h:140
#define IDID(a)
Definition: ipid.h:122
INST_VAR sleftv iiRETURNEXPR
Definition: iplib.cc:474
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:197
VAR idhdl iiCurrProc
Definition: ipshell.cc:81
void iiCheckPack(package &p)
Definition: ipshell.cc:1630
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:6562
void killlocals(int v)
Definition: ipshell.cc:386
VAR leftv iiCurrArgs
Definition: ipshell.cc:80
#define pi
Definition: libparse.cc:1145
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
#define omFreeBinAddr(addr)
Definition: omAllocDecl.h:258
VAR unsigned si_opt_2
Definition: options.c:6
VAR unsigned si_opt_1
Definition: options.c:5
idrec * idhdl
Definition: ring.h:21
void myychangebuffer()
Definition: scanner.cc:2311
#define BITSET
Definition: structs.h:16
INST_VAR sleftv sLastPrinted
Definition: subexpr.cc:46
@ STRING_CMD
Definition: tok.h:185

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1630 of file ipshell.cc.

1631 {
1632  if (p!=basePack)
1633  {
1634  idhdl t=basePack->idroot;
1635  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1636  if (t==NULL)
1637  {
1638  WarnS("package not found\n");
1639  p=basePack;
1640  }
1641  }
1642 }
int p
Definition: cfModGcd.cc:4078
idhdl next
Definition: idrec.h:38
#define WarnS
Definition: emacs.cc:78
VAR package basePack
Definition: ipid.cc:58
#define IDPACKAGE(a)
Definition: ipid.h:139
#define IDTYP(a)
Definition: ipid.h:119
@ PACKAGE_CMD
Definition: tok.h:149

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1586 of file ipshell.cc.

1587 {
1588  if (currRing==NULL)
1589  {
1590  #ifdef SIQ
1591  if (siq<=0)
1592  {
1593  #endif
1594  if (RingDependend(i))
1595  {
1596  WerrorS("no ring active (9)");
1597  return TRUE;
1598  }
1599  #ifdef SIQ
1600  }
1601  #endif
1602  }
1603  return FALSE;
1604 }
VAR BOOLEAN siq
Definition: subexpr.cc:48
BOOLEAN RingDependend(int t)
Definition: subexpr.h:142

◆ iiCheckTypes()

BOOLEAN iiCheckTypes ( leftv  args,
const short *  type_list,
int  report 
)

check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise

Parameters
type_list< [in] argument list (may be NULL) [in] field of types len, t1,t2,...
report;in] report error?

Definition at line 6562 of file ipshell.cc.

6563 {
6564  int l=0;
6565  if (args==NULL)
6566  {
6567  if (type_list[0]==0) return TRUE;
6568  }
6569  else l=args->listLength();
6570  if (l!=(int)type_list[0])
6571  {
6572  if (report) iiReportTypes(0,l,type_list);
6573  return FALSE;
6574  }
6575  for(int i=1;i<=l;i++,args=args->next)
6576  {
6577  short t=type_list[i];
6578  if (t!=ANY_TYPE)
6579  {
6580  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6581  || (t!=args->Typ()))
6582  {
6583  if (report) iiReportTypes(i,args->Typ(),type_list);
6584  return FALSE;
6585  }
6586  }
6587  }
6588  return TRUE;
6589 }
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6544
void report(const char *fmt, const char *name)
Definition: shared.cc:666
#define ANY_TYPE
Definition: tok.h:30

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 936 of file ipshell.cc.

937 {
938  int i;
939  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
940 
941  for (i=0; i<l; i++)
942  if (r[i]!=NULL) res[i]=idCopy(r[i]);
943  return res;
944 }
ideal idCopy(ideal A)
Definition: ideals.h:60
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

1066 {
1067 #ifdef HAVE_SDB
1068  sdb_flags=1;
1069 #endif
1070  Print("\n-- break point in %s --\n",VoiceName());
1072  char * s;
1074  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1075  loop
1076  {
1077  memset(s,0,BREAK_LINE_LENGTH+4);
1079  if (s[BREAK_LINE_LENGTH-1]!='\0')
1080  {
1081  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1082  }
1083  else
1084  break;
1085  }
1086  if (*s=='\n')
1087  {
1089  }
1090 #if MDEBUG
1091  else if(strncmp(s,"cont;",5)==0)
1092  {
1094  }
1095 #endif /* MDEBUG */
1096  else
1097  {
1098  strcat( s, "\n;~\n");
1100  }
1101 }
#define Print
Definition: emacs.cc:80
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:32
const char * VoiceName()
Definition: fevoices.cc:58
void VoiceBackTrack()
Definition: fevoices.cc:77
VAR BOOLEAN iiDebugMarker
Definition: ipshell.cc:1063
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:1064
VAR int sdb_flags
Definition: sdb.cc:31
#define loop
Definition: structs.h:75

◆ iiDeclCommand()

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

Definition at line 1198 of file ipshell.cc.

1199 {
1200  BOOLEAN res=FALSE;
1201  BOOLEAN is_qring=FALSE;
1202  const char *id = name->name;
1203 
1204  sy->Init();
1205  if ((name->name==NULL)||(isdigit(name->name[0])))
1206  {
1207  WerrorS("object to declare is not a name");
1208  res=TRUE;
1209  }
1210  else
1211  {
1212  if (root==NULL) return TRUE;
1213  if (*root!=IDROOT)
1214  {
1215  if ((currRing==NULL) || (*root!=currRing->idroot))
1216  {
1217  Werror("can not define `%s` in other package",name->name);
1218  return TRUE;
1219  }
1220  }
1221  if (t==QRING_CMD)
1222  {
1223  t=RING_CMD; // qring is always RING_CMD
1224  is_qring=TRUE;
1225  }
1226 
1227  if (TEST_V_ALLWARN
1228  && (name->rtyp!=0)
1229  && (name->rtyp!=IDHDL)
1230  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1231  {
1232  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1234  }
1235  {
1236  sy->data = (char *)enterid(id,lev,t,root,init_b);
1237  }
1238  if (sy->data!=NULL)
1239  {
1240  sy->rtyp=IDHDL;
1241  currid=sy->name=IDID((idhdl)sy->data);
1242  if (is_qring)
1243  {
1245  }
1246  // name->name=NULL; /* used in enterid */
1247  //sy->e = NULL;
1248  if (name->next!=NULL)
1249  {
1251  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1252  }
1253  }
1254  else res=TRUE;
1255  }
1256  name->CleanUp();
1257  return res;
1258 }
char * filename
Definition: fevoices.h:63
BITSET flag
Definition: subexpr.h:90
VAR int yylineno
Definition: febase.cc:40
VAR char my_yylinebuf[80]
Definition: febase.cc:44
const char * currid
Definition: grammar.cc:171
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:279
VAR idhdl currRingHdl
Definition: ipid.cc:59
#define IDFLAG(a)
Definition: ipid.h:120
#define FLAG_QRING_DEF
Definition: ipid.h:109
#define IDLEV(a)
Definition: ipid.h:121
#define TEST_V_ALLWARN
Definition: options.h:143
#define Sy_bit(x)
Definition: options.h:31
@ QRING_CMD
Definition: tok.h:158

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1260 of file ipshell.cc.

1261 {
1262  attr at=NULL;
1263  if (iiCurrProc!=NULL)
1264  at=iiCurrProc->attribute->get("default_arg");
1265  if (at==NULL)
1266  return FALSE;
1267  sleftv tmp;
1268  tmp.Init();
1269  tmp.rtyp=at->atyp;
1270  tmp.data=at->CopyA();
1271  return iiAssign(p,&tmp);
1272 }
attr attribute
Definition: idrec.h:41
Definition: attrib.h:21
attr get(const char *s)
Definition: attrib.cc:93
void * CopyA()
Definition: subexpr.cc:2100
int atyp
Definition: attrib.h:27

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1511 of file ipshell.cc.

1512 {
1513  BOOLEAN nok=FALSE;
1514  leftv r=v;
1515  while (v!=NULL)
1516  {
1517  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1518  {
1519  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1520  nok=TRUE;
1521  }
1522  else
1523  {
1524  if(iiInternalExport(v, toLev))
1525  nok=TRUE;
1526  }
1527  v=v->next;
1528  }
1529  r->CleanUp();
1530  return nok;
1531 }
char name() const
Definition: variable.cc:122
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1412

◆ iiExport() [2/2]

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

Definition at line 1534 of file ipshell.cc.

1535 {
1536 // if ((pack==basePack)&&(pack!=currPack))
1537 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1538  BOOLEAN nok=FALSE;
1539  leftv rv=v;
1540  while (v!=NULL)
1541  {
1542  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1543  )
1544  {
1545  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1546  nok=TRUE;
1547  }
1548  else
1549  {
1550  idhdl old=pack->idroot->get( v->name,toLev);
1551  if (old!=NULL)
1552  {
1553  if ((pack==currPack) && (old==(idhdl)v->data))
1554  {
1555  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1556  break;
1557  }
1558  else if (IDTYP(old)==v->Typ())
1559  {
1560  if (BVERBOSE(V_REDEFINE))
1561  {
1562  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1563  }
1564  v->name=omStrDup(v->name);
1565  killhdl2(old,&(pack->idroot),currRing);
1566  }
1567  else
1568  {
1569  rv->CleanUp();
1570  return TRUE;
1571  }
1572  }
1573  //Print("iiExport: pack=%s\n",IDID(root));
1574  if(iiInternalExport(v, toLev, pack))
1575  {
1576  rv->CleanUp();
1577  return TRUE;
1578  }
1579  }
1580  v=v->next;
1581  }
1582  rv->CleanUp();
1583  return nok;
1584 }
idhdl get(const char *s, int lev)
Definition: ipid.cc:72
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:445
#define BVERBOSE(a)
Definition: options.h:34
#define V_REDEFINE
Definition: options.h:44

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1606 of file ipshell.cc.

1607 {
1608  int i;
1609  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1610  poly po=NULL;
1612  {
1613  scComputeHC(I,currRing->qideal,ak,po);
1614  if (po!=NULL)
1615  {
1616  pGetCoeff(po)=nInit(1);
1617  for (i=rVar(currRing); i>0; i--)
1618  {
1619  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1620  }
1621  pSetComp(po,ak);
1622  pSetm(po);
1623  }
1624  }
1625  else
1626  po=pOne();
1627  return po;
1628 }
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition: hdegree.cc:1101
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:176
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:44
#define nInit(i)
Definition: numbers.h:24
#define pSetm(p)
Definition: polys.h:271
#define pSetComp(p, v)
Definition: polys.h:38
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pOne()
Definition: polys.h:315
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:593
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:761

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1412 of file ipshell.cc.

1413 {
1414  idhdl h=(idhdl)v->data;
1415  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1416  if (IDLEV(h)==0)
1417  {
1418  if ((myynest>0) && (BVERBOSE(V_REDEFINE))) Warn("`%s` is already global",IDID(h));
1419  }
1420  else
1421  {
1422  h=IDROOT->get(v->name,toLev);
1423  idhdl *root=&IDROOT;
1424  if ((h==NULL)&&(currRing!=NULL))
1425  {
1426  h=currRing->idroot->get(v->name,toLev);
1427  root=&currRing->idroot;
1428  }
1429  BOOLEAN keepring=FALSE;
1430  if ((h!=NULL)&&(IDLEV(h)==toLev))
1431  {
1432  if (IDTYP(h)==v->Typ())
1433  {
1434  if ((IDTYP(h)==RING_CMD)
1435  && (v->Data()==IDDATA(h)))
1436  {
1437  rIncRefCnt(IDRING(h));
1438  keepring=TRUE;
1439  IDLEV(h)=toLev;
1440  //WarnS("keepring");
1441  return FALSE;
1442  }
1443  if (BVERBOSE(V_REDEFINE))
1444  {
1445  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1446  }
1447  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1448  killhdl2(h,root,currRing);
1449  }
1450  else
1451  {
1452  WerrorS("object with a different type exists");
1453  return TRUE;
1454  }
1455  }
1456  h=(idhdl)v->data;
1457  IDLEV(h)=toLev;
1458  if (keepring) rDecRefCnt(IDRING(h));
1460  //Print("export %s\n",IDID(h));
1461  }
1462  return FALSE;
1463 }
if(!FE_OPT_NO_SHELL_FLAG)(void) system(sys)
#define IDDATA(a)
Definition: ipid.h:126
#define IDRING(a)
Definition: ipid.h:127
VAR ring * iiLocalRing
Definition: iplib.cc:473
STATIC_VAR BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
static ring rIncRefCnt(ring r)
Definition: ring.h:843
static void rDecRefCnt(ring r)
Definition: ring.h:844

◆ iiInternalExport() [2/2]

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

Definition at line 1465 of file ipshell.cc.

1466 {
1467  idhdl h=(idhdl)v->data;
1468  if(h==NULL)
1469  {
1470  Warn("'%s': no such identifier\n", v->name);
1471  return FALSE;
1472  }
1473  package frompack=v->req_packhdl;
1474  if (frompack==NULL) frompack=currPack;
1475  if ((RingDependend(IDTYP(h)))
1476  || ((IDTYP(h)==LIST_CMD)
1477  && (lRingDependend(IDLIST(h)))
1478  )
1479  )
1480  {
1481  //Print("// ==> Ringdependent set nesting to 0\n");
1482  return (iiInternalExport(v, toLev));
1483  }
1484  else
1485  {
1486  IDLEV(h)=toLev;
1487  v->req_packhdl=rootpack;
1488  if (h==frompack->idroot)
1489  {
1490  frompack->idroot=h->next;
1491  }
1492  else
1493  {
1494  idhdl hh=frompack->idroot;
1495  while ((hh!=NULL) && (hh->next!=h))
1496  hh=hh->next;
1497  if ((hh!=NULL) && (hh->next==h))
1498  hh->next=h->next;
1499  else
1500  {
1501  Werror("`%s` not found",v->Name());
1502  return TRUE;
1503  }
1504  }
1505  h->next=rootpack->idroot;
1506  rootpack->idroot=h;
1507  }
1508  return FALSE;
1509 }
#define IDLIST(a)
Definition: ipid.h:137
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199

◆ iiMakeResolv()

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

Definition at line 847 of file ipshell.cc.

849 {
850  lists L=liMakeResolv(r,length,rlen,typ0,weights);
851  int i=0;
852  idhdl h;
853  char * s=(char *)omAlloc(strlen(name)+5);
854 
855  while (i<=L->nr)
856  {
857  sprintf(s,"%s(%d)",name,i+1);
858  if (i==0)
859  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
860  else
861  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
862  if (h!=NULL)
863  {
864  h->data.uideal=(ideal)L->m[i].data;
865  h->attribute=L->m[i].attribute;
867  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
868  }
869  else
870  {
871  idDelete((ideal *)&(L->m[i].data));
872  Warn("cannot define %s",s);
873  }
874  //L->m[i].data=NULL;
875  //L->m[i].rtyp=0;
876  //L->m[i].attribute=NULL;
877  i++;
878  }
879  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
881  omFreeSize((ADDRESS)s,strlen(name)+5);
882 }
attr attribute
Definition: subexpr.h:89
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:257
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define V_DEF_RES
Definition: options.h:49

◆ iiMap()

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) )))
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))
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 #ifdef HAVE_SHIFTBBA
646  if (rIsLPRing(src_ring))
647  {
648  // src_ring [x,y,z,...]
649  // curr_ring [a,b,c,...]
650  //
651  // map=[a,b,c,d] -> [a,b,c,...]
652  // map=[a,b] -> [a,b,0,...]
653 
654  short src_lV = src_ring->isLPring;
655  short src_ncGenCount = src_ring->LPncGenCount;
656  short src_nVars = src_lV - src_ncGenCount;
657  int src_nblocks = src_ring->N / src_lV;
658 
659  short dest_nVars = currRing->isLPring - currRing->LPncGenCount;
660  short dest_ncGenCount = currRing->LPncGenCount;
661 
662  // add missing NULL generators
663  for(i=IDELEMS(theMap); i < src_lV - src_ncGenCount; i++)
664  {
665  theMap->m[i]=NULL;
666  }
667 
668  // remove superfluous generators
669  for(i = src_nVars; i < IDELEMS(theMap); i++)
670  {
671  if (theMap->m[i] != NULL)
672  {
673  p_Delete(&(theMap->m[i]), currRing);
674  theMap->m[i] = NULL;
675  }
676  }
677 
678  // add ncgen mappings
679  for(i = src_nVars; i < src_lV; i++)
680  {
681  short ncGenIndex = i - src_nVars;
682  if (ncGenIndex < dest_ncGenCount)
683  {
684  poly p = p_One(currRing);
685  p_SetExp(p, dest_nVars + ncGenIndex + 1, 1, currRing);
686  p_Setm(p, currRing);
687  theMap->m[i] = p;
688  }
689  else
690  {
691  theMap->m[i] = NULL;
692  }
693  }
694 
695  // copy the first block to all other blocks
696  for(i = 1; i < src_nblocks; i++)
697  {
698  for(int j = 0; j < src_lV; j++)
699  {
700  theMap->m[(i * src_lV) + j] = p_Copy(theMap->m[j], currRing);
701  }
702  }
703  }
704  else
705  {
706 #endif
707  for(i=IDELEMS(theMap);i<src_ring->N;i++)
708  theMap->m[i]=NULL;
709 #ifdef HAVE_SHIFTBBA
710  }
711 #endif
712  IDELEMS(theMap)=src_ring->N;
713  }
714  if (what==NULL)
715  {
716  WerrorS("argument of a map must have a name");
717  }
718  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
719  {
720  char *save_r=NULL;
722  sleftv tmpW;
723  tmpW.Init();
724  tmpW.rtyp=IDTYP(w);
725  if (tmpW.rtyp==MAP_CMD)
726  {
727  tmpW.rtyp=IDEAL_CMD;
728  save_r=IDMAP(w)->preimage;
729  IDMAP(w)->preimage=0;
730  }
731  tmpW.data=IDDATA(w);
732  // check overflow
733  BOOLEAN overflow=FALSE;
734  if ((tmpW.rtyp==IDEAL_CMD)
735  || (tmpW.rtyp==MODUL_CMD)
736  || (tmpW.rtyp==MAP_CMD))
737  {
738  ideal id=(ideal)tmpW.data;
739  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
740  for(int i=IDELEMS(id)-1;i>=0;i--)
741  {
742  poly p=id->m[i];
743  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
744  else degs[i]=0;
745  }
746  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
747  {
748  if (theMap->m[j]!=NULL)
749  {
750  long deg_monexp=pTotaldegree(theMap->m[j]);
751 
752  for(int i=IDELEMS(id)-1;i>=0;i--)
753  {
754  poly p=id->m[i];
755  if ((p!=NULL) && (degs[i]!=0) &&
756  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
757  {
758  overflow=TRUE;
759  break;
760  }
761  }
762  }
763  }
764  omFreeSize(degs,IDELEMS(id)*sizeof(long));
765  }
766  else if (tmpW.rtyp==POLY_CMD)
767  {
768  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
769  {
770  if (theMap->m[j]!=NULL)
771  {
772  long deg_monexp=pTotaldegree(theMap->m[j]);
773  poly p=(poly)tmpW.data;
774  long deg=0;
775  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
776  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
777  {
778  overflow=TRUE;
779  break;
780  }
781  }
782  }
783  }
784  if (overflow)
785 #ifdef HAVE_SHIFTBBA
786  // in Letterplace rings the exponent is always 0 or 1! ignore this warning.
787  if (!rIsLPRing(currRing))
788  {
789 #endif
790  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
791 #ifdef HAVE_SHIFTBBA
792  }
793 #endif
794 #if 0
795  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
796  {
797  v->rtyp=tmpW.rtyp;
798  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
799  }
800  else
801 #endif
802  {
803  if ((tmpW.rtyp==IDEAL_CMD)
804  ||(tmpW.rtyp==MODUL_CMD)
805  ||(tmpW.rtyp==MATRIX_CMD)
806  ||(tmpW.rtyp==MAP_CMD))
807  {
808  v->rtyp=tmpW.rtyp;
809  char *tmp = theMap->preimage;
810  theMap->preimage=(char*)1L;
811  // map gets 1 as its rank (as an ideal)
812  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
813  theMap->preimage=tmp; // map gets its preimage back
814  }
815  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
816  {
817  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
818  {
819  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
821  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
822  return NULL;
823  }
824  }
825  }
826  if (save_r!=NULL)
827  {
828  IDMAP(w)->preimage=save_r;
829  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
830  v->rtyp=MAP_CMD;
831  }
832  return v;
833  }
834  else
835  {
836  Werror("%s undefined in %s",what,theMap->preimage);
837  }
838  }
839  else
840  {
841  Werror("cannot find preimage %s",theMap->preimage);
842  }
843  return NULL;
844 }
int typ
Definition: idrec.h:43
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:700
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
const CanonicalForm & w
Definition: facAbsFact.cc:51
int j
Definition: facHensel.cc:110
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition: gen_maps.cc:87
@ MAP_CMD
Definition: grammar.cc:285
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
#define IDMAP(a)
Definition: ipid.h:135
#define IDIDEAL(a)
Definition: ipid.h:133
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:45
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
poly p_One(const ring r)
Definition: p_polys.cc:1313
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent @Note: VarOffset encodes the position in p->exp
Definition: p_polys.h:490
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:235
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:903
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:848
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1509
static long pTotaldegree(poly p)
Definition: polys.h:282
poly * polyset
Definition: polys.h:259
static BOOLEAN rIsLPRing(const ring r)
Definition: ring.h:411
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
#define IDELEMS(i)
Definition: simpleideals.h:23

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1376 of file ipshell.cc.

1377 {
1378  if (iiCurrArgs==NULL)
1379  {
1380  if (strcmp(p->name,"#")==0)
1381  return iiDefaultParameter(p);
1382  Werror("not enough arguments for proc %s",VoiceName());
1383  p->CleanUp();
1384  return TRUE;
1385  }
1386  leftv h=iiCurrArgs;
1387  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1388  BOOLEAN is_default_list=FALSE;
1389  if (strcmp(p->name,"#")==0)
1390  {
1391  is_default_list=TRUE;
1392  rest=NULL;
1393  }
1394  else
1395  {
1396  h->next=NULL;
1397  }
1398  BOOLEAN res=iiAssign(p,h);
1399  if (is_default_list)
1400  {
1401  iiCurrArgs=NULL;
1402  }
1403  else
1404  {
1405  iiCurrArgs=rest;
1406  }
1407  h->CleanUp();
1409  return res;
1410 }
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1260

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

1038 {
1039  int len,reg,typ0;
1040 
1041  resolvente r=liFindRes(L,&len,&typ0);
1042 
1043  if (r==NULL)
1044  return -2;
1045  intvec *weights=NULL;
1046  int add_row_shift=0;
1047  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
1048  if (ww!=NULL)
1049  {
1050  weights=ivCopy(ww);
1051  add_row_shift = ww->min_in();
1052  (*weights) -= add_row_shift;
1053  }
1054  //Print("attr:%x\n",weights);
1055 
1056  intvec *dummy=syBetti(r,len,&reg,weights);
1057  if (weights!=NULL) delete weights;
1058  delete dummy;
1059  omFreeSize((ADDRESS)r,len*sizeof(ideal));
1060  return reg+1+add_row_shift;
1061 }
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:132
int min_in()
Definition: intvec.h:121
intvec * ivCopy(const intvec *o)
Definition: intvec.h:145
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:770

◆ iiReportTypes()

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

Definition at line 6544 of file ipshell.cc.

6545 {
6546  char buf[250];
6547  buf[0]='\0';
6548  if (nr==0)
6549  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6550  else
6551  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6552  for(int i=1;i<=T[0];i++)
6553  {
6554  strcat(buf,"`");
6555  strcat(buf,Tok2Cmdname(T[i]));
6556  strcat(buf,"`");
6557  if (i<T[0]) strcat(buf,",");
6558  }
6559  WerrorS(buf);
6560 }
STATIC_VAR jList * T
Definition: janet.cc:30
int status int void * buf
Definition: si_signals.h:59

◆ iiSetReturn()

void iiSetReturn ( const leftv  source)

Definition at line 6591 of file ipshell.cc.

6592 {
6593  if ((source->next==NULL)&&(source->e==NULL))
6594  {
6595  if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6596  {
6597  memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6598  source->Init();
6599  return;
6600  }
6601  if (source->rtyp==IDHDL)
6602  {
6603  if ((IDLEV((idhdl)source->data)==myynest)
6604  &&(IDTYP((idhdl)source->data)!=RING_CMD))
6605  {
6606  iiRETURNEXPR.Init();
6607  iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6608  iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6609  iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6611  IDATTR((idhdl)source->data)=NULL;
6612  IDDATA((idhdl)source->data)=NULL;
6613  source->name=NULL;
6614  source->attribute=NULL;
6615  return;
6616  }
6617  }
6618  }
6619  iiRETURNEXPR.Copy(source);
6620 }
Subexpr e
Definition: subexpr.h:105
#define IDATTR(a)
Definition: ipid.h:123
@ ALIAS_CMD
Definition: tok.h:34

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6443 of file ipshell.cc.

6444 {
6445  // assume a: level
6446  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6447  {
6448  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6449  char assume_yylinebuf[80];
6450  strncpy(assume_yylinebuf,my_yylinebuf,79);
6451  int lev=(long)a->Data();
6452  int startlev=0;
6453  idhdl h=ggetid("assumeLevel");
6454  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6455  if(lev <=startlev)
6456  {
6457  BOOLEAN bo=b->Eval();
6458  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6459  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6460  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6461  }
6462  }
6463  b->CleanUp();
6464  a->CleanUp();
6465  return FALSE;
6466 }
#define IDINT(a)
Definition: ipid.h:125

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 88 of file ipshell.cc.

89 {
90  if (t<127)
91  {
92  STATIC_VAR char ch[2];
93  switch (t)
94  {
95  case '&':
96  return "and";
97  case '|':
98  return "or";
99  default:
100  ch[0]=t;
101  ch[1]='\0';
102  return ch;
103  }
104  }
105  switch (t)
106  {
107  case COLONCOLON: return "::";
108  case DOTDOT: return "..";
109  //case PLUSEQUAL: return "+=";
110  //case MINUSEQUAL: return "-=";
111  case MINUSMINUS: return "--";
112  case PLUSPLUS: return "++";
113  case EQUAL_EQUAL: return "==";
114  case LE: return "<=";
115  case GE: return ">=";
116  case NOTEQUAL: return "<>";
117  default: return Tok2Cmdname(t);
118  }
119 }
#define STATIC_VAR
Definition: globaldefs.h:7

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
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_fe;
609  Werror("cannot write to %s",s);
610  }
611  vf.CleanUp();
612  return b;
613 }
const char sNoName_fe[]
Definition: fevoices.cc:57
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:435
@ LINK_CMD
Definition: tok.h:117

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 967 of file ipshell.cc.

968 {
969  sleftv tmp;
970  tmp.Init();
971  tmp.rtyp=INT_CMD;
972  tmp.data=(void *)1;
973  if ((u->Typ()==IDEAL_CMD)
974  || (u->Typ()==MODUL_CMD))
975  return jjBETTI2_ID(res,u,&tmp);
976  else
977  return jjBETTI2(res,u,&tmp);
978 }
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:980
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:1001

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

1002 {
1003  resolvente r;
1004  int len;
1005  int reg,typ0;
1006  lists l=(lists)u->Data();
1007 
1008  intvec *weights=NULL;
1009  int add_row_shift=0;
1010  intvec *ww=NULL;
1011  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
1012  if (ww!=NULL)
1013  {
1014  weights=ivCopy(ww);
1015  add_row_shift = ww->min_in();
1016  (*weights) -= add_row_shift;
1017  }
1018  //Print("attr:%x\n",weights);
1019 
1020  r=liFindRes(l,&len,&typ0);
1021  if (r==NULL) return TRUE;
1022  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
1023  res->data=(void*)res_im;
1024  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
1025  //Print("rowShift: %d ",add_row_shift);
1026  for(int i=1;i<=res_im->rows();i++)
1027  {
1028  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
1029  else break;
1030  }
1031  //Print(" %d\n",add_row_shift);
1032  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
1033  if (weights!=NULL) delete weights;
1034  return FALSE;
1035 }
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:153
int rows() const
Definition: intvec.h:96
#define IMATELEM(M, I, J)
Definition: intvec.h:85

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

981 {
983  l->Init(1);
984  l->m[0].rtyp=u->Typ();
985  l->m[0].data=u->Data();
986  attr *a=u->Attribute();
987  if (a!=NULL)
988  l->m[0].attribute=*a;
989  sleftv tmp2;
990  tmp2.Init();
991  tmp2.rtyp=LIST_CMD;
992  tmp2.data=(void *)l;
993  BOOLEAN r=jjBETTI2(res,&tmp2,v);
994  l->m[0].data=NULL;
995  l->m[0].attribute=NULL;
996  l->m[0].rtyp=DEF_CMD;
997  l->Clean();
998  return r;
999 }
attr * Attribute()
Definition: subexpr.cc:1454
CFList tmp2
Definition: facFqBivar.cc:72
@ DEF_CMD
Definition: tok.h:58

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3346 of file ipshell.cc.

3347 {
3348  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3349  return (res->data==NULL);
3350 }
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1571

◆ jjINT_S_TO_ID()

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

Definition at line 6278 of file ipshell.cc.

6279 {
6280  if (n==0) n=1;
6281  ideal l=idInit(n,1);
6282  int i;
6283  poly p;
6284  for(i=rVar(currRing);i>0;i--)
6285  {
6286  if (e[i]>0)
6287  {
6288  n--;
6289  p=pOne();
6290  pSetExp(p,i,1);
6291  pSetm(p);
6292  l->m[n]=p;
6293  if (n==0) break;
6294  }
6295  }
6296  res->data=(char*)l;
6297  setFlag(res,FLAG_STD);
6298  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6299 }
#define setFlag(A, F)
Definition: ipid.h:113
#define FLAG_STD
Definition: ipid.h:106
#define pSetExp(p, i, v)
Definition: polys.h:42

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

947 {
948  int len=0;
949  int typ0;
950  lists L=(lists)v->Data();
951  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
952  int add_row_shift = 0;
953  if (weights==NULL)
954  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
955  if (weights!=NULL) add_row_shift=weights->min_in();
956  resolvente rr=liFindRes(L,&len,&typ0);
957  if (rr==NULL) return TRUE;
958  resolvente r=iiCopyRes(rr,len);
959 
960  syMinimizeResolvente(r,len,0);
961  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
962  len++;
963  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
964  return FALSE;
965 }
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:936
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:355

◆ jjPROC()

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

Definition at line 1619 of file iparith.cc.

1620 {
1621  void *d;
1622  Subexpr e;
1623  int typ;
1624  BOOLEAN t=FALSE;
1625  idhdl tmp_proc=NULL;
1626  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1627  {
1628  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1629  tmp_proc->id="_auto";
1630  tmp_proc->typ=PROC_CMD;
1631  tmp_proc->data.pinf=(procinfo *)u->Data();
1632  tmp_proc->ref=1;
1633  d=u->data; u->data=(void *)tmp_proc;
1634  e=u->e; u->e=NULL;
1635  t=TRUE;
1636  typ=u->rtyp; u->rtyp=IDHDL;
1637  }
1638  BOOLEAN sl;
1639  if (u->req_packhdl==currPack)
1640  sl = iiMake_proc((idhdl)u->data,NULL,v);
1641  else
1642  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1643  if (t)
1644  {
1645  u->rtyp=typ;
1646  u->data=d;
1647  u->e=e;
1648  omFreeSize(tmp_proc,sizeof(idrec));
1649  }
1650  if (sl) return TRUE;
1651  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1652  iiRETURNEXPR.Init();
1653  return FALSE;
1654 }
utypes data
Definition: idrec.h:40
short ref
Definition: idrec.h:46
const char * id
Definition: idrec.h:39
package req_packhdl
Definition: subexpr.h:106
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv args)
Definition: iplib.cc:504

◆ jjRESULTANT()

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

Definition at line 3339 of file ipshell.cc.

3340 {
3341  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3342  (poly)w->CopyD(), currRing);
3343  return errorreported;
3344 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:345
void * CopyD(int t)
Definition: subexpr.cc:710
VAR short errorreported
Definition: feFopen.cc:23

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6308 of file ipshell.cc.

6309 {
6310  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6311  ideal I=(ideal)u->Data();
6312  int i;
6313  int n=0;
6314  for(i=I->nrows*I->ncols-1;i>=0;i--)
6315  {
6316  int n0=pGetVariables(I->m[i],e);
6317  if (n0>n) n=n0;
6318  }
6319  jjINT_S_TO_ID(n,e,res);
6320  return FALSE;
6321 }
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6278
#define pGetVariables(p, e)
Definition: polys.h:251

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6300 of file ipshell.cc.

6301 {
6302  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6303  int n=pGetVariables((poly)u->Data(),e);
6304  jjINT_S_TO_ID(n,e,res);
6305  return FALSE;
6306 }

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

387 {
388  BOOLEAN changed=FALSE;
389  idhdl sh=currRingHdl;
390  ring cr=currRing;
391  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
392  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
393 
394  killlocals_rec(&(basePack->idroot),v,currRing);
395 
397  {
398  int t=iiRETURNEXPR.Typ();
399  if (/*iiRETURNEXPR.Typ()*/ t==RING_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  {
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 }
VAR int iiRETURNEXPR_len
Definition: iplib.cc:475
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:366
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1701
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:330
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:295
void rChangeCurrRing(ring r)
Definition: polys.cc:15

◆ killlocals0()

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

Definition at line 295 of file ipshell.cc.

296 {
297  idhdl h = *localhdl;
298  while (h!=NULL)
299  {
300  int vv;
301  //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
302  if ((vv=IDLEV(h))>0)
303  {
304  if (vv < v)
305  {
306  if (iiNoKeepRing)
307  {
308  //PrintS(" break\n");
309  return;
310  }
311  h = IDNEXT(h);
312  //PrintLn();
313  }
314  else //if (vv >= v)
315  {
316  idhdl nexth = IDNEXT(h);
317  killhdl2(h,localhdl,r);
318  h = nexth;
319  //PrintS("kill\n");
320  }
321  }
322  else
323  {
324  h = IDNEXT(h);
325  //PrintLn();
326  }
327  }
328 }
#define IDNEXT(a)
Definition: ipid.h:118

◆ killlocals_list()

BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 366 of file ipshell.cc.

367 {
368  if (L==NULL) return FALSE;
369  BOOLEAN changed=FALSE;
370  int n=L->nr;
371  for(;n>=0;n--)
372  {
373  leftv h=&(L->m[n]);
374  void *d=h->data;
375  if ((h->rtyp==RING_CMD)
376  && (((ring)d)->idroot!=NULL))
377  {
378  if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
379  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
380  }
381  else if (h->rtyp==LIST_CMD)
382  changed|=killlocals_list(v,(lists)d);
383  }
384  return changed;
385 }

◆ killlocals_rec()

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

Definition at line 330 of file ipshell.cc.

331 {
332  idhdl h=*root;
333  while (h!=NULL)
334  {
335  if (IDLEV(h)>=v)
336  {
337 // Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
338  idhdl n=IDNEXT(h);
339  killhdl2(h,root,r);
340  h=n;
341  }
342  else if (IDTYP(h)==PACKAGE_CMD)
343  {
344  // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
345  if (IDPACKAGE(h)!=basePack)
346  killlocals_rec(&(IDRING(h)->idroot),v,r);
347  h=IDNEXT(h);
348  }
349  else if (IDTYP(h)==RING_CMD)
350  {
351  if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
352  // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
353  {
354  // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
355  killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
356  }
357  h=IDNEXT(h);
358  }
359  else
360  {
361 // Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
362  h=IDNEXT(h);
363  }
364  }
365 }

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3322 of file ipshell.cc.

3323 {
3324  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3325  if (res->data==NULL)
3326  res->data=(char *)new intvec(rVar(currRing));
3327  return FALSE;
3328 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3300 of file ipshell.cc.

3301 {
3302  ideal F=(ideal)id->Data();
3303  intvec * iv = new intvec(rVar(currRing));
3304  polyset s;
3305  int sl, n, i;
3306  int *x;
3307 
3308  res->data=(char *)iv;
3309  s = F->m;
3310  sl = IDELEMS(F) - 1;
3311  n = rVar(currRing);
3312  double wNsqr = (double)2.0 / (double)n;
3314  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3315  wCall(s, sl, x, wNsqr, currRing);
3316  for (i = n; i!=0; i--)
3317  (*iv)[i-1] = x[i + n + 1];
3318  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3319  return FALSE;
3320 }
Variable x
Definition: cfModGcd.cc:4082
THREAD_VAR double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:20
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:108
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.cc:78

◆ list1()

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

Definition at line 149 of file ipshell.cc.

150 {
151  char buffer[22];
152  int l;
153  char buf2[128];
154 
155  if(fullname) sprintf(buf2, "%s::%s", "", IDID(h));
156  else sprintf(buf2, "%s", IDID(h));
157 
158  Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
159  if (h == currRingHdl) PrintS("*");
160  PrintS(Tok2Cmdname((int)IDTYP(h)));
161 
162  ipListFlag(h);
163  switch(IDTYP(h))
164  {
165  case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
166  case INT_CMD: Print(" %d",IDINT(h)); break;
167  case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
168  case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
169  break;
170  case POLY_CMD:
171  case VECTOR_CMD:if (c)
172  {
173  PrintS(" ");wrp(IDPOLY(h));
174  if(IDPOLY(h) != NULL)
175  {
176  Print(", %d monomial(s)",pLength(IDPOLY(h)));
177  }
178  }
179  break;
180  case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));// and continue
181  case IDEAL_CMD: Print(", %u generator(s)",
182  IDELEMS(IDIDEAL(h))); break;
183  case MAP_CMD:
184  Print(" from %s",IDMAP(h)->preimage); break;
185  case MATRIX_CMD:Print(" %u x %u"
186  ,MATROWS(IDMATRIX(h))
187  ,MATCOLS(IDMATRIX(h))
188  );
189  break;
190  case SMATRIX_CMD:Print(" %u x %u"
191  ,(int)(IDIDEAL(h)->rank)
192  ,IDELEMS(IDIDEAL(h))
193  );
194  break;
195  case PACKAGE_CMD:
196  paPrint(IDID(h),IDPACKAGE(h));
197  break;
198  case PROC_CMD: if((IDPROC(h)->libname!=NULL)
199  && (strlen(IDPROC(h)->libname)>0))
200  Print(" from %s",IDPROC(h)->libname);
201  if(IDPROC(h)->language==LANG_C)
202  PrintS(" (C)");
203  if(IDPROC(h)->is_static)
204  PrintS(" (static)");
205  break;
206  case STRING_CMD:
207  {
208  char *s;
209  l=strlen(IDSTRING(h));
210  memset(buffer,0,sizeof(buffer));
211  strncpy(buffer,IDSTRING(h),si_min(l,20));
212  if ((s=strchr(buffer,'\n'))!=NULL)
213  {
214  *s='\0';
215  }
216  PrintS(" ");
217  PrintS(buffer);
218  if((s!=NULL) ||(l>20))
219  {
220  Print("..., %d char(s)",l);
221  }
222  break;
223  }
224  case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
225  break;
226  case RING_CMD:
227  if ((IDRING(h)==currRing) && (currRingHdl!=h))
228  PrintS("(*)"); /* this is an alias to currRing */
229  //Print(" ref:%d",IDRING(h)->ref);
230 #ifdef RDEBUG
232  Print(" <%lx>",(long)(IDRING(h)));
233 #endif
234  break;
235 #ifdef SINGULAR_4_2
236  case CNUMBER_CMD:
237  { number2 n=(number2)IDDATA(h);
238  Print(" (%s)",nCoeffName(n->cf));
239  break;
240  }
241  case CMATRIX_CMD:
242  { bigintmat *b=(bigintmat*)IDDATA(h);
243  Print(" %d x %d (%s)",
244  b->rows(),b->cols(),
245  nCoeffName(b->basecoeffs()));
246  break;
247  }
248 #endif
249  /*default: break;*/
250  }
251  PrintLn();
252 }
static int si_min(const int a, const int b)
Definition: auxiliary.h:125
Matrices of numbers.
Definition: bigintmat.h:51
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition: coeffs.h:963
CanonicalForm buf2
Definition: facFqBivar.cc:73
@ SMATRIX_CMD
Definition: grammar.cc:291
void ipListFlag(idhdl h)
Definition: ipid.cc:619
#define IDMATRIX(a)
Definition: ipid.h:134
#define IDSTRING(a)
Definition: ipid.h:136
#define IDINTVEC(a)
Definition: ipid.h:128
#define IDPOLY(a)
Definition: ipid.h:130
void paPrint(const char *n, package p)
Definition: ipshell.cc:6323
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27
static unsigned pLength(poly a)
Definition: p_polys.h:191
void wrp(poly p)
Definition: polys.h:310
void PrintS(const char *s)
Definition: reporter.cc:284
void PrintLn()
Definition: reporter.cc:310
EXTERN_VAR int traceit
Definition: reporter.h:24
#define TRACE_SHOW_RINGS
Definition: reporter.h:36
@ LANG_C
Definition: subexpr.h:22
@ CMATRIX_CMD
Definition: tok.h:46
@ CNUMBER_CMD
Definition: tok.h:47

◆ list_cmd()

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)==PACKAGE_CMD)
450  )
451  {
452  h=IDRING(h)->idroot;
453  }
454  else if(IDTYP(h)==PACKAGE_CMD)
455  {
457  //Print("list_cmd:package\n");
458  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
459  h=IDPACKAGE(h)->idroot;
460  }
461  else
462  {
463  currPack=savePack;
464  return;
465  }
466  }
467  else
468  {
469  Werror("%s is undefined",what);
470  currPack=savePack;
471  return;
472  }
473  }
474  all=TRUE;
475  }
476  else if (RingDependend(typ))
477  {
478  h = currRing->idroot;
479  }
480  else
481  h = IDROOT;
482  start=h;
483  while (h!=NULL)
484  {
485  if ((all
486  && (IDTYP(h)!=PROC_CMD)
487  &&(IDTYP(h)!=PACKAGE_CMD)
488  &&(IDTYP(h)!=CRING_CMD)
489  )
490  || (typ == IDTYP(h))
491  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
492  )
493  {
494  list1(prefix,h,start==currRingHdl, fullname);
495  if ((IDTYP(h)==RING_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;
505  list_cmd(0,IDID(h),"// ",FALSE);
506  currPack=save_p;
507  }
508  }
509  h = IDNEXT(h);
510  }
511  currPack=savePack;
512 }
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:425
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:149

◆ list_error()

void list_error ( semicState  state)

Definition at line 3467 of file ipshell.cc.

3468 {
3469  switch( state )
3470  {
3471  case semicListTooShort:
3472  WerrorS( "the list is too short" );
3473  break;
3474  case semicListTooLong:
3475  WerrorS( "the list is too long" );
3476  break;
3477 
3479  WerrorS( "first element of the list should be int" );
3480  break;
3482  WerrorS( "second element of the list should be int" );
3483  break;
3485  WerrorS( "third element of the list should be int" );
3486  break;
3488  WerrorS( "fourth element of the list should be intvec" );
3489  break;
3491  WerrorS( "fifth element of the list should be intvec" );
3492  break;
3494  WerrorS( "sixth element of the list should be intvec" );
3495  break;
3496 
3497  case semicListNNegative:
3498  WerrorS( "first element of the list should be positive" );
3499  break;
3501  WerrorS( "wrong number of numerators" );
3502  break;
3504  WerrorS( "wrong number of denominators" );
3505  break;
3507  WerrorS( "wrong number of multiplicities" );
3508  break;
3509 
3510  case semicListMuNegative:
3511  WerrorS( "the Milnor number should be positive" );
3512  break;
3513  case semicListPgNegative:
3514  WerrorS( "the geometrical genus should be nonnegative" );
3515  break;
3516  case semicListNumNegative:
3517  WerrorS( "all numerators should be positive" );
3518  break;
3519  case semicListDenNegative:
3520  WerrorS( "all denominators should be positive" );
3521  break;
3522  case semicListMulNegative:
3523  WerrorS( "all multiplicities should be positive" );
3524  break;
3525 
3526  case semicListNotSymmetric:
3527  WerrorS( "it is not symmetric" );
3528  break;
3530  WerrorS( "it is not monotonous" );
3531  break;
3532 
3533  case semicListMilnorWrong:
3534  WerrorS( "the Milnor number is wrong" );
3535  break;
3536  case semicListPGWrong:
3537  WerrorS( "the geometrical genus is wrong" );
3538  break;
3539 
3540  default:
3541  WerrorS( "unspecific error" );
3542  break;
3543  }
3544 }

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4252 of file ipshell.cc.

4253 {
4254  // -------------------
4255  // check list length
4256  // -------------------
4257 
4258  if( l->nr < 5 )
4259  {
4260  return semicListTooShort;
4261  }
4262  else if( l->nr > 5 )
4263  {
4264  return semicListTooLong;
4265  }
4266 
4267  // -------------
4268  // check types
4269  // -------------
4270 
4271  if( l->m[0].rtyp != INT_CMD )
4272  {
4274  }
4275  else if( l->m[1].rtyp != INT_CMD )
4276  {
4278  }
4279  else if( l->m[2].rtyp != INT_CMD )
4280  {
4282  }
4283  else if( l->m[3].rtyp != INTVEC_CMD )
4284  {
4286  }
4287  else if( l->m[4].rtyp != INTVEC_CMD )
4288  {
4290  }
4291  else if( l->m[5].rtyp != INTVEC_CMD )
4292  {
4294  }
4295 
4296  // -------------------------
4297  // check number of entries
4298  // -------------------------
4299 
4300  int mu = (int)(long)(l->m[0].Data( ));
4301  int pg = (int)(long)(l->m[1].Data( ));
4302  int n = (int)(long)(l->m[2].Data( ));
4303 
4304  if( n <= 0 )
4305  {
4306  return semicListNNegative;
4307  }
4308 
4309  intvec *num = (intvec*)l->m[3].Data( );
4310  intvec *den = (intvec*)l->m[4].Data( );
4311  intvec *mul = (intvec*)l->m[5].Data( );
4312 
4313  if( n != num->length( ) )
4314  {
4316  }
4317  else if( n != den->length( ) )
4318  {
4320  }
4321  else if( n != mul->length( ) )
4322  {
4324  }
4325 
4326  // --------
4327  // values
4328  // --------
4329 
4330  if( mu <= 0 )
4331  {
4332  return semicListMuNegative;
4333  }
4334  if( pg < 0 )
4335  {
4336  return semicListPgNegative;
4337  }
4338 
4339  int i;
4340 
4341  for( i=0; i<n; i++ )
4342  {
4343  if( (*num)[i] <= 0 )
4344  {
4345  return semicListNumNegative;
4346  }
4347  if( (*den)[i] <= 0 )
4348  {
4349  return semicListDenNegative;
4350  }
4351  if( (*mul)[i] <= 0 )
4352  {
4353  return semicListMulNegative;
4354  }
4355  }
4356 
4357  // ----------------
4358  // check symmetry
4359  // ----------------
4360 
4361  int j;
4362 
4363  for( i=0, j=n-1; i<=j; i++,j-- )
4364  {
4365  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4366  (*den)[i] != (*den)[j] ||
4367  (*mul)[i] != (*mul)[j] )
4368  {
4369  return semicListNotSymmetric;
4370  }
4371  }
4372 
4373  // ----------------
4374  // check monotony
4375  // ----------------
4376 
4377  for( i=0, j=1; i<n/2; i++,j++ )
4378  {
4379  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4380  {
4381  return semicListNotMonotonous;
4382  }
4383  }
4384 
4385  // ---------------------
4386  // check Milnor number
4387  // ---------------------
4388 
4389  for( mu=0, i=0; i<n; i++ )
4390  {
4391  mu += (*mul)[i];
4392  }
4393 
4394  if( mu != (int)(long)(l->m[0].Data( )) )
4395  {
4396  return semicListMilnorWrong;
4397  }
4398 
4399  // -------------------------
4400  // check geometrical genus
4401  // -------------------------
4402 
4403  for( pg=0, i=0; i<n; i++ )
4404  {
4405  if( (*num)[i]<=(*den)[i] )
4406  {
4407  pg += (*mul)[i];
4408  }
4409  }
4410 
4411  if( pg != (int)(long)(l->m[1].Data( )) )
4412  {
4413  return semicListPGWrong;
4414  }
4415 
4416  return semicOK;
4417 }
void mu(int **points, int sizePoints)

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5078 of file ipshell.cc.

5079 {
5080  int i,j;
5081  int count= self->roots[0]->getAnzRoots(); // number of roots
5082  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5083 
5084  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5085 
5086  if ( self->found_roots )
5087  {
5088  listofroots->Init( count );
5089 
5090  for (i=0; i < count; i++)
5091  {
5092  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5093  onepoint->Init(elem);
5094  for ( j= 0; j < elem; j++ )
5095  {
5096  if ( !rField_is_long_C(currRing) )
5097  {
5098  onepoint->m[j].rtyp=STRING_CMD;
5099  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5100  }
5101  else
5102  {
5103  onepoint->m[j].rtyp=NUMBER_CMD;
5104  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5105  }
5106  onepoint->m[j].next= NULL;
5107  onepoint->m[j].name= NULL;
5108  }
5109  listofroots->m[i].rtyp=LIST_CMD;
5110  listofroots->m[i].data=(void *)onepoint;
5111  listofroots->m[j].next= NULL;
5112  listofroots->m[j].name= NULL;
5113  }
5114 
5115  }
5116  else
5117  {
5118  listofroots->Init( 0 );
5119  }
5120 
5121  return listofroots;
5122 }
rootContainer ** roots
Definition: mpr_numeric.h:167
bool found_roots
Definition: mpr_numeric.h:172
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition: coeffs.h:451
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:704
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:546
int status int void size_t count
Definition: si_signals.h:59

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4562 of file ipshell.cc.

4563 {
4564  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4565  return FALSE;
4566 }
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4568 of file ipshell.cc.

4569 {
4570  if ( !(rField_is_long_R(currRing)) )
4571  {
4572  WerrorS("Ground field not implemented!");
4573  return TRUE;
4574  }
4575 
4576  simplex * LP;
4577  matrix m;
4578 
4579  leftv v= args;
4580  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4581  return TRUE;
4582  else
4583  m= (matrix)(v->CopyD());
4584 
4585  LP = new simplex(MATROWS(m),MATCOLS(m));
4586  LP->mapFromMatrix(m);
4587 
4588  v= v->next;
4589  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4590  return TRUE;
4591  else
4592  LP->m= (int)(long)(v->Data());
4593 
4594  v= v->next;
4595  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4596  return TRUE;
4597  else
4598  LP->n= (int)(long)(v->Data());
4599 
4600  v= v->next;
4601  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4602  return TRUE;
4603  else
4604  LP->m1= (int)(long)(v->Data());
4605 
4606  v= v->next;
4607  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4608  return TRUE;
4609  else
4610  LP->m2= (int)(long)(v->Data());
4611 
4612  v= v->next;
4613  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4614  return TRUE;
4615  else
4616  LP->m3= (int)(long)(v->Data());
4617 
4618 #ifdef mprDEBUG_PROT
4619  Print("m (constraints) %d\n",LP->m);
4620  Print("n (columns) %d\n",LP->n);
4621  Print("m1 (<=) %d\n",LP->m1);
4622  Print("m2 (>=) %d\n",LP->m2);
4623  Print("m3 (==) %d\n",LP->m3);
4624 #endif
4625 
4626  LP->compute();
4627 
4628  lists lres= (lists)omAlloc( sizeof(slists) );
4629  lres->Init( 6 );
4630 
4631  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4632  lres->m[0].data=(void*)LP->mapToMatrix(m);
4633 
4634  lres->m[1].rtyp= INT_CMD; // found a solution?
4635  lres->m[1].data=(void*)(long)LP->icase;
4636 
4637  lres->m[2].rtyp= INTVEC_CMD;
4638  lres->m[2].data=(void*)LP->posvToIV();
4639 
4640  lres->m[3].rtyp= INTVEC_CMD;
4641  lres->m[3].data=(void*)LP->zrovToIV();
4642 
4643  lres->m[4].rtyp= INT_CMD;
4644  lres->m[4].data=(void*)(long)LP->m;
4645 
4646  lres->m[5].rtyp= INT_CMD;
4647  lres->m[5].data=(void*)(long)LP->n;
4648 
4649  res->data= (void*)lres;
4650 
4651  return FALSE;
4652 }
int m
Definition: cfEzgcd.cc:128
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:195
intvec * zrovToIV()
BOOLEAN mapFromMatrix(matrix m)
int icase
Definition: mpr_numeric.h:201
void compute()
matrix mapToMatrix(matrix m)
intvec * posvToIV()
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:543

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3070 of file ipshell.cc.

3071 {
3072  int i,j;
3073  matrix result;
3074  ideal id=(ideal)a->Data();
3075 
3076  result =mpNew(IDELEMS(id),rVar(currRing));
3077  for (i=1; i<=IDELEMS(id); i++)
3078  {
3079  for (j=1; j<=rVar(currRing); j++)
3080  {
3081  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3082  }
3083  }
3084  res->data=(char *)result;
3085  return FALSE;
3086 }
return result
Definition: facAbsBiFact.cc:75
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29
#define pDiff(a, b)
Definition: polys.h:296

◆ mpKoszul()

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

Definition at line 3092 of file ipshell.cc.

3093 {
3094  int n=(int)(long)b->Data();
3095  int d=(int)(long)c->Data();
3096  int k,l,sign,row,col;
3097  matrix result;
3098  ideal temp;
3099  BOOLEAN bo;
3100  poly p;
3101 
3102  if ((d>n) || (d<1) || (n<1))
3103  {
3104  res->data=(char *)mpNew(1,1);
3105  return FALSE;
3106  }
3107  int *choise = (int*)omAlloc(d*sizeof(int));
3108  if (id==NULL)
3109  temp=idMaxIdeal(1);
3110  else
3111  temp=(ideal)id->Data();
3112 
3113  k = binom(n,d);
3114  l = k*d;
3115  l /= n-d+1;
3116  result =mpNew(l,k);
3117  col = 1;
3118  idInitChoise(d,1,n,&bo,choise);
3119  while (!bo)
3120  {
3121  sign = 1;
3122  for (l=1;l<=d;l++)
3123  {
3124  if (choise[l-1]<=IDELEMS(temp))
3125  {
3126  p = pCopy(temp->m[choise[l-1]-1]);
3127  if (sign == -1) p = pNeg(p);
3128  sign *= -1;
3129  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3130  MATELEM(result,row,col) = p;
3131  }
3132  }
3133  col++;
3134  idGetNextChoise(d,n,&bo,choise);
3135  }
3136  omFreeSize(choise,d*sizeof(int));
3137  if (id==NULL) idDelete(&temp);
3138 
3139  res->data=(char *)result;
3140  return FALSE;
3141 }
int k
Definition: cfEzgcd.cc:99
int binom(int n, int r)
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:33
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
#define pNeg(p)
Definition: polys.h:198
#define pCopy(p)
return a copy of the poly
Definition: polys.h:185
static int sign(int x)
Definition: ring.cc:3469

◆ nuLagSolve()

BOOLEAN nuLagSolve ( leftv  res,
leftv  arg1,
leftv  arg2,
leftv  arg3 
)

find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver.

Good for polynomials with low and middle degree (<40). Arguments 3: poly arg1 , int arg2 , int arg3 arg2>0: defines precision of fractional part if ground field is Q arg3: number of iterations for approximation of roots (default=2) Returns a list of all (complex) roots of the polynomial arg1

Definition at line 4677 of file ipshell.cc.

4678 {
4679  poly gls;
4680  gls= (poly)(arg1->Data());
4681  int howclean= (int)(long)arg3->Data();
4682 
4683  if ( gls == NULL || pIsConstant( gls ) )
4684  {
4685  WerrorS("Input polynomial is constant!");
4686  return TRUE;
4687  }
4688 
4689  if (rField_is_Zp(currRing))
4690  {
4691  int* r=Zp_roots(gls, currRing);
4692  lists rlist;
4693  rlist= (lists)omAlloc( sizeof(slists) );
4694  rlist->Init( r[0] );
4695  for(int i=r[0];i>0;i--)
4696  {
4697  rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4698  rlist->m[i-1].rtyp=NUMBER_CMD;
4699  }
4700  omFree(r);
4701  res->data=rlist;
4702  res->rtyp= LIST_CMD;
4703  return FALSE;
4704  }
4705  if ( !(rField_is_R(currRing) ||
4706  rField_is_Q(currRing) ||
4709  {
4710  WerrorS("Ground field not implemented!");
4711  return TRUE;
4712  }
4713 
4716  {
4717  unsigned long int ii = (unsigned long int)arg2->Data();
4718  setGMPFloatDigits( ii, ii );
4719  }
4720 
4721  int ldummy;
4722  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4723  int i,vpos=0;
4724  poly piter;
4725  lists elist;
4726 
4727  elist= (lists)omAlloc( sizeof(slists) );
4728  elist->Init( 0 );
4729 
4730  if ( rVar(currRing) > 1 )
4731  {
4732  piter= gls;
4733  for ( i= 1; i <= rVar(currRing); i++ )
4734  if ( pGetExp( piter, i ) )
4735  {
4736  vpos= i;
4737  break;
4738  }
4739  while ( piter )
4740  {
4741  for ( i= 1; i <= rVar(currRing); i++ )
4742  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4743  {
4744  WerrorS("The input polynomial must be univariate!");
4745  return TRUE;
4746  }
4747  pIter( piter );
4748  }
4749  }
4750 
4751  rootContainer * roots= new rootContainer();
4752  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4753  piter= gls;
4754  for ( i= deg; i >= 0; i-- )
4755  {
4756  if ( piter && pTotaldegree(piter) == i )
4757  {
4758  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4759  //nPrint( pcoeffs[i] );PrintS(" ");
4760  pIter( piter );
4761  }
4762  else
4763  {
4764  pcoeffs[i]= nInit(0);
4765  }
4766  }
4767 
4768 #ifdef mprDEBUG_PROT
4769  for (i=deg; i >= 0; i--)
4770  {
4771  nPrint( pcoeffs[i] );PrintS(" ");
4772  }
4773  PrintLn();
4774 #endif
4775 
4776  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4777  roots->solver( howclean );
4778 
4779  int elem= roots->getAnzRoots();
4780  char *dummy;
4781  int j;
4782 
4783  lists rlist;
4784  rlist= (lists)omAlloc( sizeof(slists) );
4785  rlist->Init( elem );
4786 
4788  {
4789  for ( j= 0; j < elem; j++ )
4790  {
4791  rlist->m[j].rtyp=NUMBER_CMD;
4792  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4793  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4794  }
4795  }
4796  else
4797  {
4798  for ( j= 0; j < elem; j++ )
4799  {
4800  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4801  rlist->m[j].rtyp=STRING_CMD;
4802  rlist->m[j].data=(void *)dummy;
4803  }
4804  }
4805 
4806  elist->Clean();
4807  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4808 
4809  // this is (via fillContainer) the same data as in root
4810  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4811  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4812 
4813  delete roots;
4814 
4815  res->data= (void*)rlist;
4816 
4817  return FALSE;
4818 }
int * Zp_roots(poly p, const ring r)
Definition: clapsing.cc:2188
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:66
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:300
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
int getAnzRoots()
Definition: mpr_numeric.h:97
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:437
void Clean(ring r=currRing)
Definition: lists.h:26
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:538
#define pIter(p)
Definition: monomials.h:37
EXTERN_VAR size_t gmp_output_digits
Definition: mpr_base.h:115
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:60
#define nCopy(n)
Definition: numbers.h:15
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
#define pIsConstant(p)
like above, except that Comp must be 0
Definition: polys.h:238
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:519
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:501
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:507

◆ nuMPResMat()

BOOLEAN nuMPResMat ( leftv  res,
leftv  arg1,
leftv  arg2 
)

returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default)

Definition at line 4654 of file ipshell.cc.

4655 {
4656  ideal gls = (ideal)(arg1->Data());
4657  int imtype= (int)(long)arg2->Data();
4658 
4659  uResultant::resMatType mtype= determineMType( imtype );
4660 
4661  // check input ideal ( = polynomial system )
4662  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4663  {
4664  return TRUE;
4665  }
4666 
4667  uResultant *resMat= new uResultant( gls, mtype, false );
4668  if (resMat!=NULL)
4669  {
4670  res->rtyp = MODUL_CMD;
4671  res->data= (void*)resMat->accessResMat()->getMatrix();
4672  if (!errorreported) delete resMat;
4673  }
4674  return errorreported;
4675 }
virtual ideal getMatrix()
Definition: mpr_base.h:31
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:63
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
@ mprOk
Definition: mpr_base.h:98
uResultant::resMatType determineMType(int imtype)
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)

◆ nuUResSolve()

BOOLEAN nuUResSolve ( leftv  res,
leftv  args 
)

solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal).

Resultant method can be MPR_DENSE, which uses Macaulay Resultant (good for dense homogeneous polynoms) or MPR_SPARSE, which uses Sparse Resultant (Gelfand, Kapranov, Zelevinsky). Arguments 4: ideal i, int k, int l, int m k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) l>0: defines precision of fractional part if ground field is Q m=0,1,2: number of iterations for approximation of roots (default=2) Returns a list containing the roots of the system.

Definition at line 4921 of file ipshell.cc.

4922 {
4923  leftv v= args;
4924 
4925  ideal gls;
4926  int imtype;
4927  int howclean;
4928 
4929  // get ideal
4930  if ( v->Typ() != IDEAL_CMD )
4931  return TRUE;
4932  else gls= (ideal)(v->Data());
4933  v= v->next;
4934 
4935  // get resultant matrix type to use (0,1)
4936  if ( v->Typ() != INT_CMD )
4937  return TRUE;
4938  else imtype= (int)(long)v->Data();
4939  v= v->next;
4940 
4941  if (imtype==0)
4942  {
4943  ideal test_id=idInit(1,1);
4944  int j;
4945  for(j=IDELEMS(gls)-1;j>=0;j--)
4946  {
4947  if (gls->m[j]!=NULL)
4948  {
4949  test_id->m[0]=gls->m[j];
4950  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4951  if (dummy_w!=NULL)
4952  {
4953  WerrorS("Newton polytope not of expected dimension");
4954  delete dummy_w;
4955  return TRUE;
4956  }
4957  }
4958  }
4959  }
4960 
4961  // get and set precision in digits ( > 0 )
4962  if ( v->Typ() != INT_CMD )
4963  return TRUE;
4964  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4966  {
4967  unsigned long int ii=(unsigned long int)v->Data();
4968  setGMPFloatDigits( ii, ii );
4969  }
4970  v= v->next;
4971 
4972  // get interpolation steps (0,1,2)
4973  if ( v->Typ() != INT_CMD )
4974  return TRUE;
4975  else howclean= (int)(long)v->Data();
4976 
4977  uResultant::resMatType mtype= determineMType( imtype );
4978  int i,count;
4979  lists listofroots= NULL;
4980  number smv= NULL;
4981  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4982 
4983  //emptylist= (lists)omAlloc( sizeof(slists) );
4984  //emptylist->Init( 0 );
4985 
4986  //res->rtyp = LIST_CMD;
4987  //res->data= (void *)emptylist;
4988 
4989  // check input ideal ( = polynomial system )
4990  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4991  {
4992  return TRUE;
4993  }
4994 
4995  uResultant * ures;
4996  rootContainer ** iproots;
4997  rootContainer ** muiproots;
4998  rootArranger * arranger;
4999 
5000  // main task 1: setup of resultant matrix
5001  ures= new uResultant( gls, mtype );
5002  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
5003  {
5004  WerrorS("Error occurred during matrix setup!");
5005  return TRUE;
5006  }
5007 
5008  // if dense resultant, check if minor nonsingular
5009  if ( mtype == uResultant::denseResMat )
5010  {
5011  smv= ures->accessResMat()->getSubDet();
5012 #ifdef mprDEBUG_PROT
5013  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
5014 #endif
5015  if ( nIsZero(smv) )
5016  {
5017  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
5018  return TRUE;
5019  }
5020  }
5021 
5022  // main task 2: Interpolate specialized resultant polynomials
5023  if ( interpolate_det )
5024  iproots= ures->interpolateDenseSP( false, smv );
5025  else
5026  iproots= ures->specializeInU( false, smv );
5027 
5028  // main task 3: Interpolate specialized resultant polynomials
5029  if ( interpolate_det )
5030  muiproots= ures->interpolateDenseSP( true, smv );
5031  else
5032  muiproots= ures->specializeInU( true, smv );
5033 
5034 #ifdef mprDEBUG_PROT
5035  int c= iproots[0]->getAnzElems();
5036  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
5037  c= muiproots[0]->getAnzElems();
5038  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
5039 #endif
5040 
5041  // main task 4: Compute roots of specialized polys and match them up
5042  arranger= new rootArranger( iproots, muiproots, howclean );
5043  arranger->solve_all();
5044 
5045  // get list of roots
5046  if ( arranger->success() )
5047  {
5048  arranger->arrange();
5049  listofroots= listOfRoots(arranger, gmp_output_digits );
5050  }
5051  else
5052  {
5053  WerrorS("Solver was unable to find any roots!");
5054  return TRUE;
5055  }
5056 
5057  // free everything
5058  count= iproots[0]->getAnzElems();
5059  for (i=0; i < count; i++) delete iproots[i];
5060  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5061  count= muiproots[0]->getAnzElems();
5062  for (i=0; i < count; i++) delete muiproots[i];
5063  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5064 
5065  delete ures;
5066  delete arranger;
5067  if (smv!=NULL) nDelete( &smv );
5068 
5069  res->data= (void *)listofroots;
5070 
5071  //emptylist->Clean();
5072  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5073 
5074  return FALSE;
5075 }
virtual number getSubDet()
Definition: mpr_base.h:37
virtual IStateType initState() const
Definition: mpr_base.h:41
void solve_all()
Definition: mpr_numeric.cc:858
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:883
int getAnzElems()
Definition: mpr_numeric.h:95
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:3059
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2921
@ denseResMat
Definition: mpr_base.h:65
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:5078
#define nDelete(n)
Definition: numbers.h:16
#define nIsZero(n)
Definition: numbers.h:19
void pWrite(poly p)
Definition: polys.h:308

◆ nuVanderSys()

BOOLEAN nuVanderSys ( leftv  res,
leftv  arg1,
leftv  arg2,
leftv  arg3 
)

COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d.

Definition at line 4820 of file ipshell.cc.

4821 {
4822  int i;
4823  ideal p,w;
4824  p= (ideal)arg1->Data();
4825  w= (ideal)arg2->Data();
4826 
4827  // w[0] = f(p^0)
4828  // w[1] = f(p^1)
4829  // ...
4830  // p can be a vector of numbers (multivariate polynom)
4831  // or one number (univariate polynom)
4832  // tdg = deg(f)
4833 
4834  int n= IDELEMS( p );
4835  int m= IDELEMS( w );
4836  int tdg= (int)(long)arg3->Data();
4837 
4838  res->data= (void*)NULL;
4839 
4840  // check the input
4841  if ( tdg < 1 )
4842  {
4843  WerrorS("Last input parameter must be > 0!");
4844  return TRUE;
4845  }
4846  if ( n != rVar(currRing) )
4847  {
4848  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4849  return TRUE;
4850  }
4851  if ( m != (int)pow((double)tdg+1,(double)n) )
4852  {
4853  Werror("Size of second input ideal must be equal to %d!",
4854  (int)pow((double)tdg+1,(double)n));
4855  return TRUE;
4856  }
4857  if ( !(rField_is_Q(currRing) /* ||
4858  rField_is_R() || rField_is_long_R() ||
4859  rField_is_long_C()*/ ) )
4860  {
4861  WerrorS("Ground field not implemented!");
4862  return TRUE;
4863  }
4864 
4865  number tmp;
4866  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4867  for ( i= 0; i < n; i++ )
4868  {
4869  pevpoint[i]=nInit(0);
4870  if ( (p->m)[i] )
4871  {
4872  tmp = pGetCoeff( (p->m)[i] );
4873  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4874  {
4875  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4876  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4877  return TRUE;
4878  }
4879  } else tmp= NULL;
4880  if ( !nIsZero(tmp) )
4881  {
4882  if ( !pIsConstant((p->m)[i]))
4883  {
4884  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4885  WerrorS("Elements of first input ideal must be numbers!");
4886  return TRUE;
4887  }
4888  pevpoint[i]= nCopy( tmp );
4889  }
4890  }
4891 
4892  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4893  for ( i= 0; i < m; i++ )
4894  {
4895  wresults[i]= nInit(0);
4896  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4897  {
4898  if ( !pIsConstant((w->m)[i]))
4899  {
4900  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4901  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4902  WerrorS("Elements of second input ideal must be numbers!");
4903  return TRUE;
4904  }
4905  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4906  }
4907  }
4908 
4909  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4910  number *ncpoly= vm.interpolateDense( wresults );
4911  // do not free ncpoly[]!!
4912  poly rpoly= vm.numvec2poly( ncpoly );
4913 
4914  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4915  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4916 
4917  res->data= (void*)rpoly;
4918  return FALSE;
4919 }
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:411
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:29
#define nIsMOne(n)
Definition: numbers.h:26
#define nIsOne(n)
Definition: numbers.h:25

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6323 of file ipshell.cc.

6324 {
6325  Print(" %s (",n);
6326  switch (p->language)
6327  {
6328  case LANG_SINGULAR: PrintS("S"); break;
6329  case LANG_C: PrintS("C"); break;
6330  case LANG_TOP: PrintS("T"); break;
6331  case LANG_MAX: PrintS("M"); break;
6332  case LANG_NONE: PrintS("N"); break;
6333  default: PrintS("U");
6334  }
6335  if(p->libname!=NULL)
6336  Print(",%s", p->libname);
6337  PrintS(")");
6338 }
@ LANG_MAX
Definition: subexpr.h:22
@ LANG_SINGULAR
Definition: subexpr.h:22
@ LANG_TOP
Definition: subexpr.h:22

◆ rCompose()

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

Definition at line 2783 of file ipshell.cc.

2784 {
2785  if ((L->nr!=3)
2786 #ifdef HAVE_PLURAL
2787  &&(L->nr!=5)
2788 #endif
2789  )
2790  return NULL;
2791  int is_gf_char=0;
2792  // 0: char/ cf - ring
2793  // 1: list (var)
2794  // 2: list (ord)
2795  // 3: qideal
2796  // possibly:
2797  // 4: C
2798  // 5: D
2799 
2800  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2801 
2802  // ------------------------------------------------------------------
2803  // 0: char:
2804  if (L->m[0].Typ()==CRING_CMD)
2805  {
2806  R->cf=(coeffs)L->m[0].Data();
2807  R->cf->ref++;
2808  }
2809  else if (L->m[0].Typ()==INT_CMD)
2810  {
2811  int ch = (int)(long)L->m[0].Data();
2812  assume( ch >= 0 );
2813 
2814  if (ch == 0) // Q?
2815  R->cf = nInitChar(n_Q, NULL);
2816  else
2817  {
2818  int l = IsPrime(ch); // Zp?
2819  if( l != ch )
2820  {
2821  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2822  ch = l;
2823  }
2824  #ifndef TEST_ZN_AS_ZP
2825  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2826  #else
2827  mpz_t modBase;
2828  mpz_init_set_ui(modBase,(long) ch);
2829  ZnmInfo info;
2830  info.base= modBase;
2831  info.exp= 1;
2832  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2833  R->cf->is_field=1;
2834  R->cf->is_domain=1;
2835  R->cf->has_simple_Inverse=1;
2836  #endif
2837  }
2838  }
2839  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2840  {
2841  lists LL=(lists)L->m[0].Data();
2842 
2843 #ifdef HAVE_RINGS
2844  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2845  {
2846  rComposeRing(LL, R); // Ring!?
2847  }
2848  else
2849 #endif
2850  if (LL->nr < 3)
2851  rComposeC(LL,R); // R, long_R, long_C
2852  else
2853  {
2854  if (LL->m[0].Typ()==INT_CMD)
2855  {
2856  int ch = (int)(long)LL->m[0].Data();
2857  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2858  if (fftable[is_gf_char]==0) is_gf_char=-1;
2859 
2860  if(is_gf_char!= -1)
2861  {
2862  GFInfo param;
2863 
2864  param.GFChar = ch;
2865  param.GFDegree = 1;
2866  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2867 
2868  // nfInitChar should be able to handle the case when ch is in fftables!
2869  R->cf = nInitChar(n_GF, (void*)&param);
2870  }
2871  }
2872 
2873  if( R->cf == NULL )
2874  {
2875  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2876 
2877  if (extRing==NULL)
2878  {
2879  WerrorS("could not create the specified coefficient field");
2880  goto rCompose_err;
2881  }
2882 
2883  if( extRing->qideal != NULL ) // Algebraic extension
2884  {
2885  AlgExtInfo extParam;
2886 
2887  extParam.r = extRing;
2888 
2889  R->cf = nInitChar(n_algExt, (void*)&extParam);
2890  }
2891  else // Transcendental extension
2892  {
2893  TransExtInfo extParam;
2894  extParam.r = extRing;
2895  assume( extRing->qideal == NULL );
2896 
2897  R->cf = nInitChar(n_transExt, &extParam);
2898  }
2899  }
2900  }
2901  }
2902  else
2903  {
2904  WerrorS("coefficient field must be described by `int` or `list`");
2905  goto rCompose_err;
2906  }
2907 
2908  if( R->cf == NULL )
2909  {
2910  WerrorS("could not create coefficient field described by the input!");
2911  goto rCompose_err;
2912  }
2913 
2914  // ------------------------- VARS ---------------------------
2915  if (rComposeVar(L,R)) goto rCompose_err;
2916  // ------------------------ ORDER ------------------------------
2917  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2918 
2919  // ------------------------ ??????? --------------------
2920 
2921  if (!isLetterplace) rRenameVars(R);
2922  #ifdef HAVE_SHIFTBBA
2923  else
2924  {
2925  R->isLPring=isLetterplace;
2926  R->ShortOut=FALSE;
2927  R->CanShortOut=FALSE;
2928  }
2929  #endif
2930  if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2931  rComplete(R);
2932 
2933  // ------------------------ Q-IDEAL ------------------------
2934 
2935  if (L->m[3].Typ()==IDEAL_CMD)
2936  {
2937  ideal q=(ideal)L->m[3].Data();
2938  if (q->m[0]!=NULL)
2939  {
2940  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2941  {
2942  #if 0
2943  WerrorS("coefficient fields must be equal if q-ideal !=0");
2944  goto rCompose_err;
2945  #else
2946  ring orig_ring=currRing;
2947  rChangeCurrRing(R);
2948  int *perm=NULL;
2949  int *par_perm=NULL;
2950  int par_perm_size=0;
2951  nMapFunc nMap;
2952 
2953  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2954  {
2955  if (rEqual(orig_ring,currRing))
2956  {
2957  nMap=n_SetMap(currRing->cf, currRing->cf);
2958  }
2959  else
2960  // Allow imap/fetch to be make an exception only for:
2961  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2965  ||
2966  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2967  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2968  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2969  {
2970  par_perm_size=rPar(orig_ring);
2971 
2972 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2973 // naSetChar(rInternalChar(orig_ring),orig_ring);
2974 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2975 
2976  nSetChar(currRing->cf);
2977  }
2978  else
2979  {
2980  WerrorS("coefficient fields must be equal if q-ideal !=0");
2981  goto rCompose_err;
2982  }
2983  }
2984  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2985  if (par_perm_size!=0)
2986  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2987  int i;
2988  #if 0
2989  // use imap:
2990  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2991  currRing->names,currRing->N,currRing->parameter, currRing->P,
2992  perm,par_perm, currRing->ch);
2993  #else
2994  // use fetch
2995  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2996  {
2997  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2998  }
2999  else if (par_perm_size!=0)
3000  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3001  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3002  #endif
3003  ideal dest_id=idInit(IDELEMS(q),1);
3004  for(i=IDELEMS(q)-1; i>=0; i--)
3005  {
3006  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3007  par_perm,par_perm_size);
3008  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3009  pTest(dest_id->m[i]);
3010  }
3011  R->qideal=dest_id;
3012  if (perm!=NULL)
3013  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3014  if (par_perm!=NULL)
3015  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3016  rChangeCurrRing(orig_ring);
3017  #endif
3018  }
3019  else
3020  R->qideal=idrCopyR(q,currRing,R);
3021  }
3022  }
3023  else
3024  {
3025  WerrorS("q-ideal must be given as `ideal`");
3026  goto rCompose_err;
3027  }
3028 
3029 
3030  // ---------------------------------------------------------------
3031  #ifdef HAVE_PLURAL
3032  if (L->nr==5)
3033  {
3034  if (nc_CallPlural((matrix)L->m[4].Data(),
3035  (matrix)L->m[5].Data(),
3036  NULL,NULL,
3037  R,
3038  true, // !!!
3039  true, false,
3040  currRing, FALSE)) goto rCompose_err;
3041  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3042  }
3043  #endif
3044  return R;
3045 
3046 rCompose_err:
3047  if (R->N>0)
3048  {
3049  int i;
3050  if (R->names!=NULL)
3051  {
3052  i=R->N-1;
3053  while (i>=0) { omfree(R->names[i]); i--; }
3054  omFree(R->names);
3055  }
3056  }
3057  omfree(R->order);
3058  omfree(R->block0);
3059  omfree(R->block1);
3060  omfree(R->wvhdl);
3061  omFree(R);
3062  return NULL;
3063 }
ring r
Definition: algext.h:37
struct for passing initialization parameters to naInitChar
Definition: algext.h:37
int GFDegree
Definition: coeffs.h:95
@ n_GF
\GF{p^n < 2^16}
Definition: coeffs.h:32
@ n_Q
rational (GMP) numbers
Definition: coeffs.h:30
@ n_algExt
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic
Definition: coeffs.h:35
@ n_Zn
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
@ n_Zp
\F{p < 2^31}
Definition: coeffs.h:29
@ n_transExt
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:392
const unsigned short fftable[]
Definition: ffields.cc:31
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:436
const char * GFPar_name
Definition: coeffs.h:96
int GFChar
Definition: coeffs.h:94
Creation data needed for finite fields.
Definition: coeffs.h:93
const ExtensionInfo & info
< [in] sqrfree poly
static void rRenameVars(ring R)
Definition: ipshell.cc:2405
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2260
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2491
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2783
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2312
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2446
BOOLEAN nc_CallPlural(matrix cc, matrix dd, poly cn, poly dn, ring r, bool bSetupQuotient, bool bCopyInput, bool bBeQuiet, ring curr, bool dummy_ring=false)
returns TRUE if there were errors analyze inputs, check them for consistency detects nc_type,...
Definition: old.gring.cc:2682
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:163
#define assume(x)
Definition: mod2.h:389
The main handler for Singular numbers which are suitable for Singular polynomials.
#define nSetMap(R)
Definition: numbers.h:43
#define omfree(addr)
Definition: omAllocDecl.h:237
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
Definition: p_polys.cc:4246
#define pTest(p)
Definition: polys.h:415
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:192
int IsPrime(int p)
Definition: prime.cc:61
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:3492
VAR omBin sip_sring_bin
Definition: ring.cc:43
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise,...
Definition: ring.cc:1746
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:530
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:513
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:600
static int rInternalChar(const ring r)
Definition: ring.h:690
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:540
#define R
Definition: sirandom.c:27
struct for passing initialization parameters to naInitChar
Definition: transext.h:88

◆ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2260 of file ipshell.cc.

2262 {
2263  // ----------------------------------------
2264  // 0: char/ cf - ring
2265  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2266  {
2267  WerrorS("invalid coeff. field description, expecting 0");
2268  return;
2269  }
2270 // R->cf->ch=0;
2271  // ----------------------------------------
2272  // 0, (r1,r2) [, "i" ]
2273  if (L->m[1].rtyp!=LIST_CMD)
2274  {
2275  WerrorS("invalid coeff. field description, expecting precision list");
2276  return;
2277  }
2278  lists LL=(lists)L->m[1].data;
2279  if ((LL->nr!=1)
2280  || (LL->m[0].rtyp!=INT_CMD)
2281  || (LL->m[1].rtyp!=INT_CMD))
2282  {
2283  WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2284  return;
2285  }
2286  int r1=(int)(long)LL->m[0].data;
2287  int r2=(int)(long)LL->m[1].data;
2288  r1=si_min(r1,32767);
2289  r2=si_min(r2,32767);
2290  LongComplexInfo par; memset(&par, 0, sizeof(par));
2291  par.float_len=r1;
2292  par.float_len2=r2;
2293  if (L->nr==2) // complex
2294  {
2295  if (L->m[2].rtyp!=STRING_CMD)
2296  {
2297  WerrorS("invalid coeff. field description, expecting parameter name");
2298  return;
2299  }
2300  par.par_name=(char*)L->m[2].data;
2301  R->cf = nInitChar(n_long_C, &par);
2302  }
2303  else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2304  R->cf = nInitChar(n_R, NULL);
2305  else /* && L->nr==1*/
2306  {
2307  R->cf = nInitChar(n_long_R, &par);
2308  }
2309 }
@ n_R
single prescision (6,6) real numbers
Definition: coeffs.h:31
@ n_long_R
real floating point (GMP) numbers
Definition: coeffs.h:33
@ n_long_C
complex floating point (GMP) numbers
Definition: coeffs.h:41
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
const char * par_name
parameter name
Definition: coeffs.h:103
short float_len
additional char-flags, rInit
Definition: coeffs.h:101
#define SHORT_REAL_LENGTH
Definition: numbers.h:57

◆ rComposeOrder()

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

Definition at line 2491 of file ipshell.cc.

2492 {
2493  assume(R!=NULL);
2494  long bitmask=0L;
2495  if (L->m[2].Typ()==LIST_CMD)
2496  {
2497  lists v=(lists)L->m[2].Data();
2498  int n= v->nr+2;
2499  int j_in_R,j_in_L;
2500  // do we have an entry "L",... ?: set bitmask
2501  for (int j=0; j < n-1; j++)
2502  {
2503  if (v->m[j].Typ()==LIST_CMD)
2504  {
2505  lists vv=(lists)v->m[j].Data();
2506  if ((vv->nr==1)
2507  &&(vv->m[0].Typ()==STRING_CMD)
2508  &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2509  {
2510  number nn=(number)vv->m[1].Data();
2511  if (vv->m[1].Typ()==BIGINT_CMD)
2512  bitmask=n_Int(nn,coeffs_BIGINT);
2513  else if (vv->m[1].Typ()==INT_CMD)
2514  bitmask=(long)nn;
2515  else
2516  {
2517  Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2518  return TRUE;
2519  }
2520  break;
2521  }
2522  }
2523  }
2524  if (bitmask!=0) n--;
2525 
2526  // initialize fields of R
2527  R->order=(rRingOrder_t *)omAlloc0((n+1)*sizeof(rRingOrder_t));
2528  R->block0=(int *)omAlloc0((n+1)*sizeof(int));
2529  R->block1=(int *)omAlloc0((n+1)*sizeof(int));
2530  R->wvhdl=(int**)omAlloc0((n+1)*sizeof(int_ptr));
2531  // init order, so that rBlocks works correctly
2532  for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2533  R->order[j_in_R] = ringorder_unspec;
2534  // orderings
2535  for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2536  {
2537  // todo: a(..), M
2538  if (v->m[j_in_L].Typ()!=LIST_CMD)
2539  {
2540  WerrorS("ordering must be list of lists");
2541  return TRUE;
2542  }
2543  lists vv=(lists)v->m[j_in_L].Data();
2544  if ((vv->nr==1)
2545  && (vv->m[0].Typ()==STRING_CMD))
2546  {
2547  if (strcmp((char*)vv->m[0].Data(),"L")==0)
2548  {
2549  j_in_R--;
2550  continue;
2551  }
2552  if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD)
2553  && (vv->m[1].Typ()!=INTMAT_CMD))
2554  {
2555  PrintS(lString(vv));
2556  Werror("ordering name must be a (string,intvec), not (string,%s)",Tok2Cmdname(vv->m[1].Typ()));
2557  return TRUE;
2558  }
2559  R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2560 
2561  if (j_in_R==0) R->block0[0]=1;
2562  else
2563  {
2564  int jj=j_in_R-1;
2565  while((jj>=0)
2566  && ((R->order[jj]== ringorder_a)
2567  || (R->order[jj]== ringorder_aa)
2568  || (R->order[jj]== ringorder_am)
2569  || (R->order[jj]== ringorder_c)
2570  || (R->order[jj]== ringorder_C)
2571  || (R->order[jj]== ringorder_s)
2572  || (R->order[jj]== ringorder_S)
2573  ))
2574  {
2575  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2576  jj--;
2577  }
2578  if (jj<0) R->block0[j_in_R]=1;
2579  else R->block0[j_in_R]=R->block1[jj]+1;
2580  }
2581  intvec *iv;
2582  if (vv->m[1].Typ()==INT_CMD)
2583  {
2584  int l=si_max(1,(int)(long)vv->m[1].Data());
2585  iv=new intvec(l);
2586  for(int i=0;i<l;i++) (*iv)[i]=1;
2587  }
2588  else
2589  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC/INTMAT
2590  int iv_len=iv->length();
2591  if (iv_len==0)
2592  {
2593  Werror("empty intvec for ordering %d (%s)",j_in_R+1,rSimpleOrdStr(R->order[j_in_R]));
2594  return TRUE;
2595  }
2596  if (R->order[j_in_R]==ringorder_M)
2597  {
2598  if (vv->m[1].rtyp==INTMAT_CMD) iv->makeVector();
2599  iv_len=iv->length();
2600  }
2601  if ((R->order[j_in_R]!=ringorder_s)
2602  &&(R->order[j_in_R]!=ringorder_c)
2603  &&(R->order[j_in_R]!=ringorder_C))
2604  {
2605  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2606  if (R->block1[j_in_R]>R->N)
2607  {
2608  if (R->block0[j_in_R]>R->N)
2609  {
2610  Werror("not enough variables for ordering %d (%s)",j_in_R,rSimpleOrdStr(R->order[j_in_R]));
2611  return TRUE;
2612  }
2613  R->block1[j_in_R]=R->N;
2614  iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2615  }
2616  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2617  }
2618  int i;
2619  switch (R->order[j_in_R])
2620  {
2621  case ringorder_ws:
2622  case ringorder_Ws:
2623  R->OrdSgn=-1; // and continue
2624  case ringorder_aa:
2625  case ringorder_a:
2626  case ringorder_wp:
2627  case ringorder_Wp:
2628  R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2629  for (i=0; i<iv_len;i++)
2630  {
2631  R->wvhdl[j_in_R][i]=(*iv)[i];
2632  }
2633  break;
2634  case ringorder_am:
2635  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2636  for (i=0; i<iv_len;i++)
2637  {
2638  R->wvhdl[j_in_R][i]=(*iv)[i];
2639  }
2640  R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2641  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2642  for (; i<iv->length(); i++)
2643  {
2644  R->wvhdl[j_in_R][i+1]=(*iv)[i];
2645  }
2646  break;
2647  case ringorder_M:
2648  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2649  for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2650  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length())));
2651  if (R->block1[j_in_R]>R->N)
2652  {
2653  R->block1[j_in_R]=R->N;
2654  }
2655  break;
2656  case ringorder_ls:
2657  case ringorder_ds:
2658  case ringorder_Ds:
2659  case ringorder_rs:
2660  R->OrdSgn=-1;
2661  case ringorder_lp:
2662  case ringorder_dp:
2663  case ringorder_Dp:
2664  case ringorder_rp:
2665  #if 0
2666  for (i=0; i<iv_len;i++)
2667  {
2668  if (((*iv)[i]!=1)&&(iv_len!=1))
2669  {
2670  iv->show(1);
2671  Warn("ignore weight %d for ord %d (%s) at pos %d\n>>%s<<",
2672  (*iv)[i],j_in_R+1,rSimpleOrdStr(R->order[j_in_R]),i+1,my_yylinebuf);
2673  break;
2674  }
2675  }
2676  #endif // break absfact.tst
2677  break;
2678  case ringorder_S:
2679  break;
2680  case ringorder_c:
2681  case ringorder_C:
2682  R->block1[j_in_R]=R->block0[j_in_R]=0;
2683  break;
2684 
2685  case ringorder_s:
2686  R->block1[j_in_R]=R->block0[j_in_R]=(*iv)[0];
2687  rSetSyzComp(R->block0[j_in_R],R);
2688  break;
2689 
2690  case ringorder_IS:
2691  {
2692  R->block1[j_in_R] = R->block0[j_in_R] = 0;
2693  if( iv->length() > 0 )
2694  {
2695  const int s = (*iv)[0];
2696  assume( -2 < s && s < 2 );
2697  R->block1[j_in_R] = R->block0[j_in_R] = s;
2698  }
2699  break;
2700  }
2701  case 0:
2702  case ringorder_unspec:
2703  break;
2704  case ringorder_L: /* cannot happen */
2705  case ringorder_a64: /*not implemented */
2706  WerrorS("ring order not implemented");
2707  return TRUE;
2708  }
2709  delete iv;
2710  }
2711  else
2712  {
2713  PrintS(lString(vv));
2714  WerrorS("ordering name must be a (string,intvec)");
2715  return TRUE;
2716  }
2717  }
2718  // sanity check
2719  j_in_R=n-2;
2720  if ((R->order[j_in_R]==ringorder_c)
2721  || (R->order[j_in_R]==ringorder_C)
2722  || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2723  if (R->block1[j_in_R] != R->N)
2724  {
2725  if (((R->order[j_in_R]==ringorder_dp) ||
2726  (R->order[j_in_R]==ringorder_ds) ||
2727  (R->order[j_in_R]==ringorder_Dp) ||
2728  (R->order[j_in_R]==ringorder_Ds) ||
2729  (R->order[j_in_R]==ringorder_rp) ||
2730  (R->order[j_in_R]==ringorder_rs) ||
2731  (R->order[j_in_R]==ringorder_lp) ||
2732  (R->order[j_in_R]==ringorder_ls))
2733  &&
2734  R->block0[j_in_R] <= R->N)
2735  {
2736  R->block1[j_in_R] = R->N;
2737  }
2738  else
2739  {
2740  Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2741  return TRUE;
2742  }
2743  }
2744  if (R->block0[j_in_R]>R->N)
2745  {
2746  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2747  for(int ii=0;ii<=j_in_R;ii++)
2748  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2749  return TRUE;
2750  }
2751  if (check_comp)
2752  {
2753  BOOLEAN comp_order=FALSE;
2754  int jj;
2755  for(jj=0;jj<n;jj++)
2756  {
2757  if ((R->order[jj]==ringorder_c) ||
2758  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2759  }
2760  if (!comp_order)
2761  {
2762  R->order=(rRingOrder_t*)omRealloc0Size(R->order,n*sizeof(rRingOrder_t),(n+1)*sizeof(rRingOrder_t));
2763  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2764  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2765  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2766  R->order[n-1]=ringorder_C;
2767  R->block0[n-1]=0;
2768  R->block1[n-1]=0;
2769  R->wvhdl[n-1]=NULL;
2770  n++;
2771  }
2772  }
2773  }
2774  else
2775  {
2776  WerrorS("ordering must be given as `list`");
2777  return TRUE;
2778  }
2779  if (bitmask!=0) { R->bitmask=bitmask; R->wanted_maxExp=bitmask; }
2780  return FALSE;
2781 }
static int si_max(const int a, const int b)
Definition: auxiliary.h:124
void makeVector()
Definition: intvec.h:102
void show(int mat=0, int spaces=0) const
Definition: intvec.cc:149
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ....
Definition: coeffs.h:547
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
char * lString(lists l, BOOLEAN typed, int dim)
Definition: lists.cc:380
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:327
#define omRealloc0Size(addr, o_size, size)
Definition: omAllocDecl.h:221
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:77
rRingOrder_t rOrderName(char *ordername)
Definition: ring.cc:507
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:5166
rRingOrder_t
order stuff
Definition: ring.h:68
@ ringorder_lp
Definition: ring.h:77
@ ringorder_a
Definition: ring.h:70
@ ringorder_am
Definition: ring.h:88
@ ringorder_a64
for int64 weights
Definition: ring.h:71
@ ringorder_rs
opposite of ls
Definition: ring.h:92
@ ringorder_C
Definition: ring.h:73
@ ringorder_S
S?
Definition: ring.h:75
@ ringorder_ds
Definition: ring.h:84
@ ringorder_Dp
Definition: ring.h:80
@ ringorder_unspec
Definition: ring.h:94
@ ringorder_L
Definition: ring.h:89
@ ringorder_Ds
Definition: ring.h:85
@ ringorder_dp
Definition: ring.h:78
@ ringorder_c
Definition: ring.h:72
@ ringorder_rp
Definition: ring.h:79
@ ringorder_aa
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:91
@ ringorder_Wp
Definition: ring.h:82
@ ringorder_ws
Definition: ring.h:86
@ ringorder_Ws
Definition: ring.h:87
@ ringorder_IS
Induced (Schreyer) ordering.
Definition: ring.h:93
@ ringorder_ls
Definition: ring.h:83
@ ringorder_s
s?
Definition: ring.h:76
@ ringorder_wp
Definition: ring.h:81
@ ringorder_M
Definition: ring.h:74
int * int_ptr
Definition: structs.h:54
@ BIGINT_CMD
Definition: tok.h:38

◆ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2312 of file ipshell.cc.

2314 {
2315  // ----------------------------------------
2316  // 0: string: integer
2317  // no further entries --> Z
2318  mpz_t modBase;
2319  unsigned int modExponent = 1;
2320 
2321  if (L->nr == 0)
2322  {
2323  mpz_init_set_ui(modBase,0);
2324  modExponent = 1;
2325  }
2326  // ----------------------------------------
2327  // 1:
2328  else
2329  {
2330  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2331  lists LL=(lists)L->m[1].data;
2332  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2333  {
2334  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2335  // assume that tmp is integer, not rational
2336  mpz_init(modBase);
2337  n_MPZ (modBase, tmp, coeffs_BIGINT);
2338  }
2339  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2340  {
2341  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2342  }
2343  else
2344  {
2345  mpz_init_set_ui(modBase,0);
2346  }
2347  if (LL->nr >= 1)
2348  {
2349  modExponent = (unsigned long) LL->m[1].data;
2350  }
2351  else
2352  {
2353  modExponent = 1;
2354  }
2355  }
2356  // ----------------------------------------
2357  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
2358  {
2359  WerrorS("Wrong ground ring specification (module is 1)");
2360  return;
2361  }
2362  if (modExponent < 1)
2363  {
2364  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2365  return;
2366  }
2367  // module is 0 ---> integers
2368  if (mpz_sgn1(modBase) == 0)
2369  {
2370  R->cf=nInitChar(n_Z,NULL);
2371  }
2372  // we have an exponent
2373  else if (modExponent > 1)
2374  {
2375  //R->cf->ch = R->cf->modExponent;
2376  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2377  {
2378  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2379  depending on the size of a long on the respective platform */
2380  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2381  }
2382  else
2383  {
2384  //ringtype 3
2385  ZnmInfo info;
2386  info.base= modBase;
2387  info.exp= modExponent;
2388  R->cf=nInitChar(n_Znm,(void*) &info);
2389  }
2390  }
2391  // just a module m > 1
2392  else
2393  {
2394  //ringtype = 2;
2395  //const int ch = mpz_get_ui(modBase);
2396  ZnmInfo info;
2397  info.base= modBase;
2398  info.exp= modExponent;
2399  R->cf=nInitChar(n_Zn,(void*) &info);
2400  }
2401  mpz_clear(modBase);
2402 }
@ n_Znm
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
@ n_Z2m
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
@ n_Z
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition: coeffs.h:551
#define mpz_sgn1(A)
Definition: si_gmp.h:18

◆ rComposeVar()

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

Definition at line 2446 of file ipshell.cc.

2447 {
2448  assume(R!=NULL);
2449  if (L->m[1].Typ()==LIST_CMD)
2450  {
2451  lists v=(lists)L->m[1].Data();
2452  R->N = v->nr+1;
2453  if (R->N<=0)
2454  {
2455  WerrorS("no ring variables");
2456  return TRUE;
2457  }
2458  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2459  int i;
2460  for(i=0;i<R->N;i++)
2461  {
2462  if (v->m[i].Typ()==STRING_CMD)
2463  R->names[i]=omStrDup((char *)v->m[i].Data());
2464  else if (v->m[i].Typ()==POLY_CMD)
2465  {
2466  poly p=(poly)v->m[i].Data();
2467  int nr=pIsPurePower(p);
2468  if (nr>0)
2469  R->names[i]=omStrDup(currRing->names[nr-1]);
2470  else
2471  {
2472  Werror("var name %d must be a string or a ring variable",i+1);
2473  return TRUE;
2474  }
2475  }
2476  else
2477  {
2478  Werror("var name %d must be `string` (not %d)",i+1, v->m[i].Typ());
2479  return TRUE;
2480  }
2481  }
2482  }
2483  else
2484  {
2485  WerrorS("variable must be given as `list`");
2486  return TRUE;
2487  }
2488  return FALSE;
2489 }
#define pIsPurePower(p)
Definition: polys.h:248
char * char_ptr
Definition: structs.h:53

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2161 of file ipshell.cc.

2162 {
2163  assume( r != NULL );
2164  const coeffs C = r->cf;
2165  assume( C != NULL );
2166 
2167  // sanity check: require currRing==r for rings with polynomial data
2168  if ( (r!=currRing) && (
2169  (nCoeff_is_algExt(C) && (C != currRing->cf))
2170  || (r->qideal != NULL)
2171 #ifdef HAVE_PLURAL
2172  || (rIsPluralRing(r))
2173 #endif
2174  )
2175  )
2176  {
2177  WerrorS("ring with polynomial data must be the base ring or compatible");
2178  return NULL;
2179  }
2180  // 0: char/ cf - ring
2181  // 1: list (var)
2182  // 2: list (ord)
2183  // 3: qideal
2184  // possibly:
2185  // 4: C
2186  // 5: D
2188  if (rIsPluralRing(r))
2189  L->Init(6);
2190  else
2191  L->Init(4);
2192  // ----------------------------------------
2193  // 0: char/ cf - ring
2194  if (rField_is_numeric(r))
2195  {
2196  rDecomposeC(&(L->m[0]),r);
2197  }
2198  else if (rField_is_Ring(r))
2199  {
2200  rDecomposeRing(&(L->m[0]),r);
2201  }
2202  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2203  {
2204  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2205  }
2206  else if(rField_is_GF(r))
2207  {
2209  Lc->Init(4);
2210  // char:
2211  Lc->m[0].rtyp=INT_CMD;
2212  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2213  // var:
2215  Lv->Init(1);
2216  Lv->m[0].rtyp=STRING_CMD;
2217  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2218  Lc->m[1].rtyp=LIST_CMD;
2219  Lc->m[1].data=(void*)Lv;
2220  // ord:
2222  Lo->Init(1);
2224  Loo->Init(2);
2225  Loo->m[0].rtyp=STRING_CMD;
2226  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2227 
2228  intvec *iv=new intvec(1); (*iv)[0]=1;
2229  Loo->m[1].rtyp=INTVEC_CMD;
2230  Loo->m[1].data=(void *)iv;
2231 
2232  Lo->m[0].rtyp=LIST_CMD;
2233  Lo->m[0].data=(void*)Loo;
2234 
2235  Lc->m[2].rtyp=LIST_CMD;
2236  Lc->m[2].data=(void*)Lo;
2237  // q-ideal:
2238  Lc->m[3].rtyp=IDEAL_CMD;
2239  Lc->m[3].data=(void *)idInit(1,1);
2240  // ----------------------
2241  L->m[0].rtyp=LIST_CMD;
2242  L->m[0].data=(void*)Lc;
2243  }
2244  else if (rField_is_Zp(r) || rField_is_Q(r))
2245  {
2246  L->m[0].rtyp=INT_CMD;
2247  L->m[0].data=(void *)(long)r->cf->ch;
2248  }
2249  else
2250  {
2251  L->m[0].rtyp=CRING_CMD;
2252  L->m[0].data=(void *)r->cf;
2253  r->cf->ref++;
2254  }
2255  // ----------------------------------------
2256  rDecompose_23456(r,L);
2257  return L;
2258 }
CanonicalForm Lc(const CanonicalForm &f)
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:910
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1853
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1729
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1917
static void rDecompose_23456(const ring r, lists L)
Definition: ipshell.cc:2021
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:400
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:626
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:516
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:522
#define rField_is_Ring(R)
Definition: ring.h:486

◆ rDecompose_23456()

static void rDecompose_23456 ( const ring  r,
lists  L 
)
static

Definition at line 2021 of file ipshell.cc.

2022 {
2023  // ----------------------------------------
2024  // 1: list (var)
2026  LL->Init(r->N);
2027  int i;
2028  for(i=0; i<r->N; i++)
2029  {
2030  LL->m[i].rtyp=STRING_CMD;
2031  LL->m[i].data=(void *)omStrDup(r->names[i]);
2032  }
2033  L->m[1].rtyp=LIST_CMD;
2034  L->m[1].data=(void *)LL;
2035  // ----------------------------------------
2036  // 2: list (ord)
2038  i=rBlocks(r)-1;
2039  LL->Init(i);
2040  i--;
2041  lists LLL;
2042  for(; i>=0; i--)
2043  {
2044  intvec *iv;
2045  int j;
2046  LL->m[i].rtyp=LIST_CMD;
2048  LLL->Init(2);
2049  LLL->m[0].rtyp=STRING_CMD;
2050  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2051 
2052  if((r->order[i] == ringorder_IS)
2053  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2054  {
2055  assume( r->block0[i] == r->block1[i] );
2056  const int s = r->block0[i];
2057  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2058 
2059  iv=new intvec(1);
2060  (*iv)[0] = s;
2061  }
2062  else if (r->block1[i]-r->block0[i] >=0 )
2063  {
2064  int bl=j=r->block1[i]-r->block0[i];
2065  if (r->order[i]==ringorder_M)
2066  {
2067  j=(j+1)*(j+1)-1;
2068  bl=j+1;
2069  }
2070  else if (r->order[i]==ringorder_am)
2071  {
2072  j+=r->wvhdl[i][bl+1];
2073  }
2074  iv=new intvec(j+1);
2075  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2076  {
2077  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2078  }
2079  else switch (r->order[i])
2080  {
2081  case ringorder_dp:
2082  case ringorder_Dp:
2083  case ringorder_ds:
2084  case ringorder_Ds:
2085  case ringorder_lp:
2086  case ringorder_ls:
2087  case ringorder_rp:
2088  for(;j>=0; j--) (*iv)[j]=1;
2089  break;
2090  default: /* do nothing */;
2091  }
2092  }
2093  else
2094  {
2095  iv=new intvec(1);
2096  }
2097  LLL->m[1].rtyp=INTVEC_CMD;
2098  LLL->m[1].data=(void *)iv;
2099  LL->m[i].data=(void *)LLL;
2100  }
2101  L->m[2].rtyp=LIST_CMD;
2102  L->m[2].data=(void *)LL;
2103  // ----------------------------------------
2104  // 3: qideal
2105  L->m[3].rtyp=IDEAL_CMD;
2106  if (r->qideal==NULL)
2107  L->m[3].data=(void *)idInit(1,1);
2108  else
2109  L->m[3].data=(void *)idCopy(r->qideal);
2110  // ----------------------------------------
2111 #ifdef HAVE_PLURAL // NC! in rDecompose
2112  if (rIsPluralRing(r))
2113  {
2114  L->m[4].rtyp=MATRIX_CMD;
2115  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2116  L->m[5].rtyp=MATRIX_CMD;
2117  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2118  }
2119 #endif
2120 }
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
static int rBlocks(const ring r)
Definition: ring.h:569

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1949 of file ipshell.cc.

1950 {
1951  assume( C != NULL );
1952 
1953  // sanity check: require currRing==r for rings with polynomial data
1954  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1955  {
1956  WerrorS("ring with polynomial data must be the base ring or compatible");
1957  return TRUE;
1958  }
1959  if (nCoeff_is_numeric(C))
1960  {
1961  rDecomposeC_41(res,C);
1962  }
1963 #ifdef HAVE_RINGS
1964  else if (nCoeff_is_Ring(C))
1965  {
1967  }
1968 #endif
1969  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1970  {
1971  rDecomposeCF(res, C->extRing, currRing);
1972  }
1973  else if(nCoeff_is_GF(C))
1974  {
1976  Lc->Init(4);
1977  // char:
1978  Lc->m[0].rtyp=INT_CMD;
1979  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1980  // var:
1982  Lv->Init(1);
1983  Lv->m[0].rtyp=STRING_CMD;
1984  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1985  Lc->m[1].rtyp=LIST_CMD;
1986  Lc->m[1].data=(void*)Lv;
1987  // ord:
1989  Lo->Init(1);
1991  Loo->Init(2);
1992  Loo->m[0].rtyp=STRING_CMD;
1993  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1994 
1995  intvec *iv=new intvec(1); (*iv)[0]=1;
1996  Loo->m[1].rtyp=INTVEC_CMD;
1997  Loo->m[1].data=(void *)iv;
1998 
1999  Lo->m[0].rtyp=LIST_CMD;
2000  Lo->m[0].data=(void*)Loo;
2001 
2002  Lc->m[2].rtyp=LIST_CMD;
2003  Lc->m[2].data=(void*)Lo;
2004  // q-ideal:
2005  Lc->m[3].rtyp=IDEAL_CMD;
2006  Lc->m[3].data=(void *)idInit(1,1);
2007  // ----------------------
2008  res->rtyp=LIST_CMD;
2009  res->data=(void*)Lc;
2010  }
2011  else
2012  {
2013  res->rtyp=INT_CMD;
2014  res->data=(void *)(long)C->ch;
2015  }
2016  // ----------------------------------------
2017  return FALSE;
2018 }
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:839
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:832
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:778
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:730
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1819
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1889

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2122 of file ipshell.cc.

2123 {
2124  assume( r != NULL );
2125  const coeffs C = r->cf;
2126  assume( C != NULL );
2127 
2128  // sanity check: require currRing==r for rings with polynomial data
2129  if ( (r!=currRing) && (
2130  (r->qideal != NULL)
2131 #ifdef HAVE_PLURAL
2132  || (rIsPluralRing(r))
2133 #endif
2134  )
2135  )
2136  {
2137  WerrorS("ring with polynomial data must be the base ring or compatible");
2138  return NULL;
2139  }
2140  // 0: char/ cf - ring
2141  // 1: list (var)
2142  // 2: list (ord)
2143  // 3: qideal
2144  // possibly:
2145  // 4: C
2146  // 5: D
2148  if (rIsPluralRing(r))
2149  L->Init(6);
2150  else
2151  L->Init(4);
2152  // ----------------------------------------
2153  // 0: char/ cf - ring
2154  L->m[0].rtyp=CRING_CMD;
2155  L->m[0].data=(char*)r->cf; r->cf->ref++;
2156  // ----------------------------------------
2157  rDecompose_23456(r,L);
2158  return L;
2159 }

◆ rDecomposeC()

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

Definition at line 1853 of file ipshell.cc.

1855 {
1857  if (rField_is_long_C(R)) L->Init(3);
1858  else L->Init(2);
1859  h->rtyp=LIST_CMD;
1860  h->data=(void *)L;
1861  // 0: char/ cf - ring
1862  // 1: list (var)
1863  // 2: list (ord)
1864  // ----------------------------------------
1865  // 0: char/ cf - ring
1866  L->m[0].rtyp=INT_CMD;
1867  L->m[0].data=(void *)0;
1868  // ----------------------------------------
1869  // 1:
1871  LL->Init(2);
1872  LL->m[0].rtyp=INT_CMD;
1873  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1874  LL->m[1].rtyp=INT_CMD;
1875  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1876  L->m[1].rtyp=LIST_CMD;
1877  L->m[1].data=(void *)LL;
1878  // ----------------------------------------
1879  // 2: list (par)
1880  if (rField_is_long_C(R))
1881  {
1882  L->m[2].rtyp=STRING_CMD;
1883  L->m[2].data=(void *)omStrDup(*rParameter(R));
1884  }
1885  // ----------------------------------------
1886 }

◆ rDecomposeC_41()

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

Definition at line 1819 of file ipshell.cc.

1821 {
1823  if (nCoeff_is_long_C(C)) L->Init(3);
1824  else L->Init(2);
1825  h->rtyp=LIST_CMD;
1826  h->data=(void *)L;
1827  // 0: char/ cf - ring
1828  // 1: list (var)
1829  // 2: list (ord)
1830  // ----------------------------------------
1831  // 0: char/ cf - ring
1832  L->m[0].rtyp=INT_CMD;
1833  L->m[0].data=(void *)0;
1834  // ----------------------------------------
1835  // 1:
1837  LL->Init(2);
1838  LL->m[0].rtyp=INT_CMD;
1839  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1840  LL->m[1].rtyp=INT_CMD;
1841  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1842  L->m[1].rtyp=LIST_CMD;
1843  L->m[1].data=(void *)LL;
1844  // ----------------------------------------
1845  // 2: list (par)
1846  if (nCoeff_is_long_C(C))
1847  {
1848  L->m[2].rtyp=STRING_CMD;
1849  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1850  }
1851  // ----------------------------------------
1852 }
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:894

◆ rDecomposeCF()

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

Definition at line 1729 of file ipshell.cc.

1730 {
1732  L->Init(4);
1733  h->rtyp=LIST_CMD;
1734  h->data=(void *)L;
1735  // 0: char/ cf - ring
1736  // 1: list (var)
1737  // 2: list (ord)
1738  // 3: qideal
1739  // ----------------------------------------
1740  // 0: char/ cf - ring
1741  L->m[0].rtyp=INT_CMD;
1742  L->m[0].data=(void *)(long)r->cf->ch;
1743  // ----------------------------------------
1744  // 1: list (var)
1746  LL->Init(r->N);
1747  int i;
1748  for(i=0; i<r->N; i++)
1749  {
1750  LL->m[i].rtyp=STRING_CMD;
1751  LL->m[i].data=(void *)omStrDup(r->names[i]);
1752  }
1753  L->m[1].rtyp=LIST_CMD;
1754  L->m[1].data=(void *)LL;
1755  // ----------------------------------------
1756  // 2: list (ord)
1758  i=rBlocks(r)-1;
1759  LL->Init(i);
1760  i--;
1761  lists LLL;
1762  for(; i>=0; i--)
1763  {
1764  intvec *iv;
1765  int j;
1766  LL->m[i].rtyp=LIST_CMD;
1768  LLL->Init(2);
1769  LLL->m[0].rtyp=STRING_CMD;
1770  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1771  if (r->block1[i]-r->block0[i] >=0 )
1772  {
1773  j=r->block1[i]-r->block0[i];
1774  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1775  iv=new intvec(j+1);
1776  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1777  {
1778  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1779  }
1780  else switch (r->order[i])
1781  {
1782  case ringorder_dp:
1783  case ringorder_Dp:
1784  case ringorder_ds:
1785  case ringorder_Ds:
1786  case ringorder_lp:
1787  case ringorder_rp:
1788  case ringorder_ls:
1789  for(;j>=0; j--) (*iv)[j]=1;
1790  break;
1791  default: /* do nothing */;
1792  }
1793  }
1794  else
1795  {
1796  iv=new intvec(1);
1797  }
1798  LLL->m[1].rtyp=INTVEC_CMD;
1799  LLL->m[1].data=(void *)iv;
1800  LL->m[i].data=(void *)LLL;
1801  }
1802  L->m[2].rtyp=LIST_CMD;
1803  L->m[2].data=(void *)LL;
1804  // ----------------------------------------
1805  // 3: qideal
1806  L->m[3].rtyp=IDEAL_CMD;
1807  if (nCoeff_is_transExt(R->cf))
1808  L->m[3].data=(void *)idInit(1,1);
1809  else
1810  {
1811  ideal q=idInit(IDELEMS(r->qideal));
1812  q->m[0]=p_Init(R);
1813  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1814  L->m[3].data=(void *)q;
1815 // I->m[0] = pNSet(R->minpoly);
1816  }
1817  // ----------------------------------------
1818 }
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:918
#define pSetCoeff0(p, n)
Definition: monomials.h:59
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1322

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1917 of file ipshell.cc.

1919 {
1920 #ifdef HAVE_RINGS
1922  if (rField_is_Z(R)) L->Init(1);
1923  else L->Init(2);
1924  h->rtyp=LIST_CMD;
1925  h->data=(void *)L;
1926  // 0: char/ cf - ring
1927  // 1: list (module)
1928  // ----------------------------------------
1929  // 0: char/ cf - ring
1930  L->m[0].rtyp=STRING_CMD;
1931  L->m[0].data=(void *)omStrDup("integer");
1932  // ----------------------------------------
1933  // 1: module
1934  if (rField_is_Z(R)) return;
1936  LL->Init(2);
1937  LL->m[0].rtyp=BIGINT_CMD;
1938  LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1939  LL->m[1].rtyp=INT_CMD;
1940  LL->m[1].data=(void *) R->cf->modExponent;
1941  L->m[1].rtyp=LIST_CMD;
1942  L->m[1].data=(void *)LL;
1943 #else
1944  WerrorS("rDecomposeRing");
1945 #endif
1946 }
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:542
static BOOLEAN rField_is_Z(const ring r)
Definition: ring.h:510

◆ rDecomposeRing_41()

void rDecomposeRing_41 ( leftv  h,
const coeffs  C 
)

Definition at line 1889 of file ipshell.cc.

1891 {
1893  if (nCoeff_is_Ring(C)) L->Init(1);
1894  else L->Init(2);
1895  h->rtyp=LIST_CMD;
1896  h->data=(void *)L;
1897  // 0: char/ cf - ring
1898  // 1: list (module)
1899  // ----------------------------------------
1900  // 0: char/ cf - ring
1901  L->m[0].rtyp=STRING_CMD;
1902  L->m[0].data=(void *)omStrDup("integer");
1903  // ----------------------------------------
1904  // 1: modulo
1905  if (nCoeff_is_Z(C)) return;
1907  LL->Init(2);
1908  LL->m[0].rtyp=BIGINT_CMD;
1909  LL->m[0].data=n_InitMPZ( C->modBase, coeffs_BIGINT);
1910  LL->m[1].rtyp=INT_CMD;
1911  LL->m[1].data=(void *) C->modExponent;
1912  L->m[1].rtyp=LIST_CMD;
1913  L->m[1].data=(void *)LL;
1914 }
static FORCE_INLINE BOOLEAN nCoeff_is_Z(const coeffs r)
Definition: coeffs.h:816

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1644 of file ipshell.cc.

1645 {
1646  idhdl tmp=NULL;
1647 
1648  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1649  if (tmp==NULL) return NULL;
1650 
1651 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1653  {
1655  }
1656 
1657  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1658 
1659  #ifndef TEST_ZN_AS_ZP
1660  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1661  #else
1662  mpz_t modBase;
1663  mpz_init_set_ui(modBase, (long)32003);
1664  ZnmInfo info;
1665  info.base= modBase;
1666  info.exp= 1;
1667  r->cf=nInitChar(n_Zn,(void*) &info);
1668  r->cf->is_field=1;
1669  r->cf->is_domain=1;
1670  r->cf->has_simple_Inverse=1;
1671  #endif
1672  r->N = 3;
1673  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1674  /*names*/
1675  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1676  r->names[0] = omStrDup("x");
1677  r->names[1] = omStrDup("y");
1678  r->names[2] = omStrDup("z");
1679  /*weights: entries for 3 blocks: NULL*/
1680  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1681  /*order: dp,C,0*/
1682  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1683  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1684  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1685  /* ringorder dp for the first block: var 1..3 */
1686  r->order[0] = ringorder_dp;
1687  r->block0[0] = 1;
1688  r->block1[0] = 3;
1689  /* ringorder C for the second block: no vars */
1690  r->order[1] = ringorder_C;
1691  /* the last block: everything is 0 */
1692  r->order[2] = (rRingOrder_t)0;
1693 
1694  /* complete ring intializations */
1695  rComplete(r);
1696  rSetHdl(tmp);
1697  return currRingHdl;
1698 }
BOOLEAN RingDependend()
Definition: subexpr.cc:418

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1701 of file ipshell.cc.

1702 {
1703  if ((r==NULL)||(r->VarOffset==NULL))
1704  return NULL;
1706  if (h!=NULL) return h;
1707  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1708  if (h!=NULL) return h;
1710  while(p!=NULL)
1711  {
1712  if ((p->cPack!=basePack)
1713  && (p->cPack!=currPack))
1714  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1715  if (h!=NULL) return h;
1716  p=p->next;
1717  }
1718  idhdl tmp=basePack->idroot;
1719  while (tmp!=NULL)
1720  {
1721  if (IDTYP(tmp)==PACKAGE_CMD)
1722  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1723  if (h!=NULL) return h;
1724  tmp=IDNEXT(tmp);
1725  }
1726  return NULL;
1727 }
Definition: ipid.h:56
VAR proclevel * procstack
Definition: ipid.cc:52
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition: ipshell.cc:6259

◆ rInit()

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

Definition at line 5624 of file ipshell.cc.

5625 {
5626  int float_len=0;
5627  int float_len2=0;
5628  ring R = NULL;
5629  //BOOLEAN ffChar=FALSE;
5630 
5631  /* ch -------------------------------------------------------*/
5632  // get ch of ground field
5633 
5634  // allocated ring
5635  R = (ring) omAlloc0Bin(sip_sring_bin);
5636 
5637  coeffs cf = NULL;
5638 
5639  assume( pn != NULL );
5640  const int P = pn->listLength();
5641 
5642  if (pn->Typ()==CRING_CMD)
5643  {
5644  cf=(coeffs)pn->CopyD();
5645  leftv pnn=pn;
5646  if(P>1) /*parameter*/
5647  {
5648  pnn = pnn->next;
5649  const int pars = pnn->listLength();
5650  assume( pars > 0 );
5651  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5652 
5653  if (rSleftvList2StringArray(pnn, names))
5654  {
5655  WerrorS("parameter expected");
5656  goto rInitError;
5657  }
5658 
5659  TransExtInfo extParam;
5660 
5661  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5662  for(int i=pars-1; i>=0;i--)
5663  {
5664  omFree(names[i]);
5665  }
5666  omFree(names);
5667 
5668  cf = nInitChar(n_transExt, &extParam);
5669  }
5670  assume( cf != NULL );
5671  }
5672  else if (pn->Typ()==INT_CMD)
5673  {
5674  int ch = (int)(long)pn->Data();
5675  leftv pnn=pn;
5676 
5677  /* parameter? -------------------------------------------------------*/
5678  pnn = pnn->next;
5679 
5680  if (pnn == NULL) // no params!?
5681  {
5682  if (ch!=0)
5683  {
5684  int ch2=IsPrime(ch);
5685  if ((ch<2)||(ch!=ch2))
5686  {
5687  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5688  ch=32003;
5689  }
5690  #ifndef TEST_ZN_AS_ZP
5691  cf = nInitChar(n_Zp, (void*)(long)ch);
5692  #else
5693  mpz_t modBase;
5694  mpz_init_set_ui(modBase, (long)ch);
5695  ZnmInfo info;
5696  info.base= modBase;
5697  info.exp= 1;
5698  cf=nInitChar(n_Zn,(void*) &info);
5699  cf->is_field=1;
5700  cf->is_domain=1;
5701  cf->has_simple_Inverse=1;
5702  #endif
5703  }
5704  else
5705  cf = nInitChar(n_Q, (void*)(long)ch);
5706  }
5707  else
5708  {
5709  const int pars = pnn->listLength();
5710 
5711  assume( pars > 0 );
5712 
5713  // predefined finite field: (p^k, a)
5714  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5715  {
5716  GFInfo param;
5717 
5718  param.GFChar = ch;
5719  param.GFDegree = 1;
5720  param.GFPar_name = pnn->name;
5721 
5722  cf = nInitChar(n_GF, &param);
5723  }
5724  else // (0/p, a, b, ..., z)
5725  {
5726  if ((ch!=0) && (ch!=IsPrime(ch)))
5727  {
5728  WerrorS("too many parameters");
5729  goto rInitError;
5730  }
5731 
5732  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5733 
5734  if (rSleftvList2StringArray(pnn, names))
5735  {
5736  WerrorS("parameter expected");
5737  goto rInitError;
5738  }
5739 
5740  TransExtInfo extParam;
5741 
5742  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5743  for(int i=pars-1; i>=0;i--)
5744  {
5745  omFree(names[i]);
5746  }
5747  omFree(names);
5748 
5749  cf = nInitChar(n_transExt, &extParam);
5750  }
5751  }
5752 
5753  //if (cf==NULL) ->Error: Invalid ground field specification
5754  }
5755  else if ((pn->name != NULL)
5756  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5757  {
5758  leftv pnn=pn->next;
5759  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5760  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5761  {
5762  float_len=(int)(long)pnn->Data();
5763  float_len2=float_len;
5764  pnn=pnn->next;
5765  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5766  {
5767  float_len2=(int)(long)pnn->Data();
5768  pnn=pnn->next;
5769  }
5770  }
5771 
5772  if (!complex_flag)
5773  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5774  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5775  cf=nInitChar(n_R, NULL);
5776  else // longR or longC?
5777  {
5778  LongComplexInfo param;
5779 
5780  param.float_len = si_min (float_len, 32767);
5781  param.float_len2 = si_min (float_len2, 32767);
5782 
5783  // set the parameter name
5784  if (complex_flag)
5785  {
5786  if (param.float_len < SHORT_REAL_LENGTH)
5787  {
5790  }
5791  if ((pnn == NULL) || (pnn->name == NULL))
5792  param.par_name=(const char*)"i"; //default to i
5793  else
5794  param.par_name = (const char*)pnn->name;
5795  }
5796 
5797  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5798  }
5799  assume( cf != NULL );
5800  }
5801 #ifdef HAVE_RINGS
5802  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5803  {
5804  // TODO: change to use coeffs_BIGINT!?
5805  mpz_t modBase;
5806  unsigned int modExponent = 1;
5807  mpz_init_set_si(modBase, 0);
5808  if (pn->next!=NULL)
5809  {
5810  leftv pnn=pn;
5811  if (pnn->next->Typ()==INT_CMD)
5812  {
5813  pnn=pnn->next;
5814  mpz_set_ui(modBase, (long) pnn->Data());
5815  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5816  {
5817  pnn=pnn->next;
5818  modExponent = (long) pnn->Data();
5819  }
5820  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5821  {
5822  pnn=pnn->next;
5823  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5824  }
5825  }
5826  else if (pnn->next->Typ()==BIGINT_CMD)
5827  {
5828  number p=(number)pnn->next->CopyD();
5829  n_MPZ(modBase,p,coeffs_BIGINT);
5831  }
5832  }
5833  else
5834  cf=nInitChar(n_Z,NULL);
5835 
5836  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5837  {
5838  WerrorS("Wrong ground ring specification (module is 1)");
5839  goto rInitError;
5840  }
5841  if (modExponent < 1)
5842  {
5843  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5844  goto rInitError;
5845  }
5846  // module is 0 ---> integers ringtype = 4;
5847  // we have an exponent
5848  if (modExponent > 1 && cf == NULL)
5849  {
5850  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5851  {
5852  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5853  depending on the size of a long on the respective platform */
5854  //ringtype = 1; // Use Z/2^ch
5855  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5856  }
5857  else
5858  {
5859  if (mpz_sgn1(modBase)==0)
5860  {
5861  WerrorS("modulus must not be 0 or parameter not allowed");
5862  goto rInitError;
5863  }
5864  //ringtype = 3;
5865  ZnmInfo info;
5866  info.base= modBase;
5867  info.exp= modExponent;
5868  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5869  }
5870  }
5871  // just a module m > 1
5872  else if (cf == NULL)
5873  {
5874  if (mpz_sgn1(modBase)==0)
5875  {
5876  WerrorS("modulus must not be 0 or parameter not allowed");
5877  goto rInitError;
5878  }
5879  //ringtype = 2;
5880  ZnmInfo info;
5881  info.base= modBase;
5882  info.exp= modExponent;
5883  cf=nInitChar(n_Zn,(void*) &info);
5884  }
5885  assume( cf != NULL );
5886  mpz_clear(modBase);
5887  }
5888 #endif
5889  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5890  else if ((pn->Typ()==RING_CMD) && (P == 1))
5891  {
5892  TransExtInfo extParam;
5893  extParam.r = (ring)pn->Data();
5894  extParam.r->ref++;
5895  cf = nInitChar(n_transExt, &extParam);
5896  }
5897  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5898  //{
5899  // AlgExtInfo extParam;
5900  // extParam.r = (ring)pn->Data();
5901 
5902  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5903  //}
5904  else
5905  {
5906  WerrorS("Wrong or unknown ground field specification");
5907 #if 0
5908 // debug stuff for unknown cf descriptions:
5909  sleftv* p = pn;
5910  while (p != NULL)
5911  {
5912  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5913  PrintLn();
5914  p = p->next;
5915  }
5916 #endif
5917  goto rInitError;
5918  }
5919 
5920  /*every entry in the new ring is initialized to 0*/
5921 
5922  /* characteristic -----------------------------------------------*/
5923  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5924  * 0 1 : Q(a,...) *names FALSE
5925  * 0 -1 : R NULL FALSE 0
5926  * 0 -1 : R NULL FALSE prec. >6
5927  * 0 -1 : C *names FALSE prec. 0..?
5928  * p p : Fp NULL FALSE
5929  * p -p : Fp(a) *names FALSE
5930  * q q : GF(q=p^n) *names TRUE
5931  */
5932  if (cf==NULL)
5933  {
5934  WerrorS("Invalid ground field specification");
5935  goto rInitError;
5936 // const int ch=32003;
5937 // cf=nInitChar(n_Zp, (void*)(long)ch);
5938  }
5939 
5940  assume( R != NULL );
5941 
5942  R->cf = cf;
5943 
5944  /* names and number of variables-------------------------------------*/
5945  {
5946  int l=rv->listLength();
5947 
5948  if (l>MAX_SHORT)
5949  {
5950  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5951  goto rInitError;
5952  }
5953  R->N = l; /*rv->listLength();*/
5954  }
5955  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5956  if (rSleftvList2StringArray(rv, R->names))
5957  {
5958  WerrorS("name of ring variable expected");
5959  goto rInitError;
5960  }
5961 
5962  /* check names and parameters for conflicts ------------------------- */
5963  rRenameVars(R); // conflicting variables will be renamed
5964  /* ordering -------------------------------------------------------------*/
5965  if (rSleftvOrdering2Ordering(ord, R))
5966  goto rInitError;
5967 
5968  // Complete the initialization
5969  if (rComplete(R,1))
5970  goto rInitError;
5971 
5972 /*#ifdef HAVE_RINGS
5973 // currently, coefficients which are ring elements require a global ordering:
5974  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5975  {
5976  WerrorS("global ordering required for these coefficients");
5977  goto rInitError;
5978  }
5979 #endif*/
5980 
5981  rTest(R);
5982 
5983  // try to enter the ring into the name list
5984  // need to clean up sleftv here, before this ring can be set to
5985  // new currRing or currRing can be killed beacuse new ring has
5986  // same name
5987  pn->CleanUp();
5988  rv->CleanUp();
5989  ord->CleanUp();
5990  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5991  // goto rInitError;
5992 
5993  //memcpy(IDRING(tmp),R,sizeof(*R));
5994  // set current ring
5995  //omFreeBin(R, ip_sring_bin);
5996  //return tmp;
5997  return R;
5998 
5999  // error case:
6000  rInitError:
6001  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
6002  pn->CleanUp();
6003  rv->CleanUp();
6004  ord->CleanUp();
6005  return NULL;
6006 }
CanonicalForm cf
Definition: cfModGcd.cc:4083
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
const short MAX_SHORT
Definition: ipshell.cc:5612
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5304
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5576
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:450
#define rTest(r)
Definition: ring.h:786

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6216 of file ipshell.cc.

6217 {
6218  ring r = IDRING(h);
6219  int ref=0;
6220  if (r!=NULL)
6221  {
6222  // avoid, that sLastPrinted is the last reference to the base ring:
6223  // clean up before killing the last "named" refrence:
6224  if ((sLastPrinted.rtyp==RING_CMD)
6225  && (sLastPrinted.data==(void*)r))
6226  {
6227  sLastPrinted.CleanUp(r);
6228  }
6229  ref=r->ref;
6230  if ((ref<=0)&&(r==currRing))
6231  {
6232  // cleanup DENOMINATOR_LIST
6233  if (DENOMINATOR_LIST!=NULL)
6234  {
6236  if (TEST_V_ALLWARN)
6237  Warn("deleting denom_list for ring change from %s",IDID(h));
6238  do
6239  {
6240  n_Delete(&(dd->n),currRing->cf);
6241  dd=dd->next;
6243  DENOMINATOR_LIST=dd;
6244  } while(DENOMINATOR_LIST!=NULL);
6245  }
6246  }
6247  rKill(r);
6248  }
6249  if (h==currRingHdl)
6250  {
6251  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6252  else
6253  {
6255  }
6256  }
6257 }
void rKill(ring r)
Definition: ipshell.cc:6170
VAR denominator_list DENOMINATOR_LIST
Definition: kutil.cc:84
denominator_list next
Definition: kutil.h:65

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6170 of file ipshell.cc.

6171 {
6172  if ((r->ref<=0)&&(r->order!=NULL))
6173  {
6174 #ifdef RDEBUG
6175  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6176 #endif
6177  int j;
6178  for (j=0;j<myynest;j++)
6179  {
6180  if (iiLocalRing[j]==r)
6181  {
6182  if (j==0) WarnS("killing the basering for level 0");
6183  iiLocalRing[j]=NULL;
6184  }
6185  }
6186 // any variables depending on r ?
6187  while (r->idroot!=NULL)
6188  {
6189  r->idroot->lev=myynest; // avoid warning about kill global objects
6190  killhdl2(r->idroot,&(r->idroot),r);
6191  }
6192  if (r==currRing)
6193  {
6194  // all dependend stuff is done, clean global vars:
6195  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6197  {
6199  }
6200  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6201  //{
6202  // WerrorS("return value depends on local ring variable (export missing ?)");
6203  // iiRETURNEXPR.CleanUp();
6204  //}
6205  currRing=NULL;
6206  currRingHdl=NULL;
6207  }
6208 
6209  /* nKillChar(r); will be called from inside of rDelete */
6210  rDelete(r);
6211  return;
6212  }
6213  rDecRefCnt(r);
6214 }
#define pDelete(p_ptr)
Definition: polys.h:186

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5185 of file ipshell.cc.

5186 {
5187  // change some bad orderings/combination into better ones
5188  leftv h=ord;
5189  while(h!=NULL)
5190  {
5191  BOOLEAN change=FALSE;
5192  intvec *iv = (intvec *)(h->data);
5193  // ws(-i) -> wp(i)
5194  if ((*iv)[1]==ringorder_ws)
5195  {
5196  BOOLEAN neg=TRUE;
5197  for(int i=2;i<iv->length();i++)
5198  if((*iv)[i]>=0) { neg=FALSE; break; }
5199  if (neg)
5200  {
5201  (*iv)[1]=ringorder_wp;
5202  for(int i=2;i<iv->length();i++)
5203  (*iv)[i]= - (*iv)[i];
5204  change=TRUE;
5205  }
5206  }
5207  // Ws(-i) -> Wp(i)
5208  if ((*iv)[1]==ringorder_Ws)
5209  {
5210  BOOLEAN neg=TRUE;
5211  for(int i=2;i<iv->length();i++)
5212  if((*iv)[i]>=0) { neg=FALSE; break; }
5213  if (neg)
5214  {
5215  (*iv)[1]=ringorder_Wp;
5216  for(int i=2;i<iv->length();i++)
5217  (*iv)[i]= -(*iv)[i];
5218  change=TRUE;
5219  }
5220  }
5221  // wp(1) -> dp
5222  if ((*iv)[1]==ringorder_wp)
5223  {
5224  BOOLEAN all_one=TRUE;
5225  for(int i=2;i<iv->length();i++)
5226  if((*iv)[i]!=1) { all_one=FALSE; break; }
5227  if (all_one)
5228  {
5229  intvec *iv2=new intvec(3);
5230  (*iv2)[0]=1;
5231  (*iv2)[1]=ringorder_dp;
5232  (*iv2)[2]=iv->length()-2;
5233  delete iv;
5234  iv=iv2;
5235  h->data=iv2;
5236  change=TRUE;
5237  }
5238  }
5239  // Wp(1) -> Dp
5240  if ((*iv)[1]==ringorder_Wp)
5241  {
5242  BOOLEAN all_one=TRUE;
5243  for(int i=2;i<iv->length();i++)
5244  if((*iv)[i]!=1) { all_one=FALSE; break; }
5245  if (all_one)
5246  {
5247  intvec *iv2=new intvec(3);
5248  (*iv2)[0]=1;
5249  (*iv2)[1]=ringorder_Dp;
5250  (*iv2)[2]=iv->length()-2;
5251  delete iv;
5252  iv=iv2;
5253  h->data=iv2;
5254  change=TRUE;
5255  }
5256  }
5257  // dp(1)/Dp(1)/rp(1) -> lp(1)
5258  if (((*iv)[1]==ringorder_dp)
5259  || ((*iv)[1]==ringorder_Dp)
5260  || ((*iv)[1]==ringorder_rp))
5261  {
5262  if (iv->length()==3)
5263  {
5264  if ((*iv)[2]==1)
5265  {
5266  if(h->next!=NULL)
5267  {
5268  intvec *iv2 = (intvec *)(h->next->data);
5269  if ((*iv2)[1]==ringorder_lp)
5270  {
5271  (*iv)[1]=ringorder_lp;
5272  change=TRUE;
5273  }
5274  }
5275  }
5276  }
5277  }
5278  // lp(i),lp(j) -> lp(i+j)
5279  if(((*iv)[1]==ringorder_lp)
5280  && (h->next!=NULL))
5281  {
5282  intvec *iv2 = (intvec *)(h->next->data);
5283  if ((*iv2)[1]==ringorder_lp)
5284  {
5285  leftv hh=h->next;
5286  h->next=hh->next;
5287  hh->next=NULL;
5288  if ((*iv2)[0]==1)
5289  (*iv)[2] += 1; // last block unspecified, at least 1
5290  else
5291  (*iv)[2] += (*iv2)[2];
5292  hh->CleanUp();
5293  omFreeBin(hh,sleftv_bin);
5294  change=TRUE;
5295  }
5296  }
5297  // -------------------
5298  if (!change) h=h->next;
5299  }
5300  return ord;
5301 }

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2405 of file ipshell.cc.

2406 {
2407  int i,j;
2408  BOOLEAN ch;
2409  do
2410  {
2411  ch=0;
2412  for(i=0;i<R->N-1;i++)
2413  {
2414  for(j=i+1;j<R->N;j++)
2415  {
2416  if (strcmp(R->names[i],R->names[j])==0)
2417  {
2418  ch=TRUE;
2419  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`in >>%s<<\nin %s:%d",i+1,j+1,R->names[i],R->names[i],my_yylinebuf,currentVoice->filename,yylineno);
2420  omFree(R->names[j]);
2421  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2422  sprintf(R->names[j],"@%s",R->names[i]);
2423  }
2424  }
2425  }
2426  }
2427  while (ch);
2428  for(i=0;i<rPar(R); i++)
2429  {
2430  for(j=0;j<R->N;j++)
2431  {
2432  if (strcmp(rParameter(R)[i],R->names[j])==0)
2433  {
2434  Warn("name conflict par(%d) and var(%d): `%s`, rename the VARIABLE to `@@(%d)`in >>%s<<\nin %s:%d",i+1,j+1,R->names[j],i+1,my_yylinebuf,currentVoice->filename,yylineno);
2435 // omFree(rParameter(R)[i]);
2436 // rParameter(R)[i]=(char *)omAlloc(10);
2437 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2438  omFree(R->names[j]);
2439  R->names[j]=(char *)omAlloc(10);
2440  sprintf(R->names[j],"@@(%d)",i+1);
2441  }
2442  }
2443  }
2444 }

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5125 of file ipshell.cc.

5126 {
5127  ring rg = NULL;
5128  if (h!=NULL)
5129  {
5130 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5131  rg = IDRING(h);
5132  if (rg==NULL) return; //id <>NULL, ring==NULL
5133  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5134  if (IDID(h)) // OB: ????
5136  rTest(rg);
5137  }
5138  else return;
5139 
5140  // clean up history
5141  if (currRing!=NULL)
5142  {
5144  {
5146  }
5147 
5148  if (rg!=currRing)/*&&(currRing!=NULL)*/
5149  {
5150  if (rg->cf!=currRing->cf)
5151  {
5153  if (DENOMINATOR_LIST!=NULL)
5154  {
5155  if (TEST_V_ALLWARN)
5156  Warn("deleting denom_list for ring change to %s",IDID(h));
5157  do
5158  {
5159  n_Delete(&(dd->n),currRing->cf);
5160  dd=dd->next;
5162  DENOMINATOR_LIST=dd;
5163  } while(DENOMINATOR_LIST!=NULL);
5164  }
5165  }
5166  }
5167  }
5168 
5169  // test for valid "currRing":
5170  if ((rg!=NULL) && (rg->idroot==NULL))
5171  {
5172  ring old=rg;
5173  rg=rAssure_HasComp(rg);
5174  if (old!=rg)
5175  {
5176  rKill(old);
5177  IDRING(h)=rg;
5178  }
5179  }
5180  /*------------ change the global ring -----------------------*/
5181  rChangeCurrRing(rg);
5182  currRingHdl = h;
5183 }
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4705

◆ rSimpleFindHdl()

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

Definition at line 6259 of file ipshell.cc.

6260 {
6261  idhdl h=root;
6262  while (h!=NULL)
6263  {
6264  if ((IDTYP(h)==RING_CMD)
6265  && (h!=n)
6266  && (IDRING(h)==r)
6267  )
6268  {
6269  return h;
6270  }
6271  h=IDNEXT(h);
6272  }
6273  return NULL;
6274 }

◆ rSleftvList2StringArray()

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

Definition at line 5576 of file ipshell.cc.

5577 {
5578 
5579  while(sl!=NULL)
5580  {
5581  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5582  {
5583  *p = omStrDup(sl->Name());
5584  }
5585  else if (sl->name!=NULL)
5586  {
5587  *p = (char*)sl->name;
5588  sl->name=NULL;
5589  }
5590  else if (sl->rtyp==POLY_CMD)
5591  {
5592  sleftv s_sl;
5593  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5594  if (s_sl.name != NULL)
5595  {
5596  *p = (char*)s_sl.name; s_sl.name=NULL;
5597  }
5598  else
5599  *p = NULL;
5600  sl->next = s_sl.next;
5601  s_sl.next = NULL;
5602  s_sl.CleanUp();
5603  if (*p == NULL) return TRUE;
5604  }
5605  else return TRUE;
5606  p++;
5607  sl=sl->next;
5608  }
5609  return FALSE;
5610 }

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5304 of file ipshell.cc.

5305 {
5306  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5307  ord=rOptimizeOrdAsSleftv(ord);
5308  sleftv *sl = ord;
5309 
5310  // determine nBlocks
5311  while (sl!=NULL)
5312  {
5313  intvec *iv = (intvec *)(sl->data);
5314  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5315  i++;
5316  else if ((*iv)[1]==ringorder_L)
5317  {
5318  R->wanted_maxExp=(*iv)[2]*2+1;
5319  n--;
5320  }
5321  else if (((*iv)[1]!=ringorder_a)
5322  && ((*iv)[1]!=ringorder_a64)
5323  && ((*iv)[1]!=ringorder_am))
5324  o++;
5325  n++;
5326  sl=sl->next;
5327  }
5328  // check whether at least one real ordering
5329  if (o==0)
5330  {
5331  WerrorS("invalid combination of orderings");
5332  return TRUE;
5333  }
5334  // if no c/C ordering is given, increment n
5335  if (i==0) n++;
5336  else if (i != 1)
5337  {
5338  // throw error if more than one is given
5339  WerrorS("more than one ordering c/C specified");
5340  return TRUE;
5341  }
5342 
5343  // initialize fields of R
5344  R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
5345  R->block0=(int *)omAlloc0(n*sizeof(int));
5346  R->block1=(int *)omAlloc0(n*sizeof(int));
5347  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5348 
5349  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5350 
5351  // init order, so that rBlocks works correctly
5352  for (j=0; j < n-1; j++)
5353  R->order[j] = ringorder_unspec;
5354  // set last _C order, if no c/C order was given
5355  if (i == 0) R->order[n-2] = ringorder_C;
5356 
5357  /* init orders */
5358  sl=ord;
5359  n=-1;
5360  while (sl!=NULL)
5361  {
5362  intvec *iv;
5363  iv = (intvec *)(sl->data);
5364  if ((*iv)[1]!=ringorder_L)
5365  {
5366  n++;
5367 
5368  /* the format of an ordering:
5369  * iv[0]: factor
5370  * iv[1]: ordering
5371  * iv[2..end]: weights
5372  */
5373  R->order[n] = (rRingOrder_t)((*iv)[1]);
5374  typ=1;
5375  switch ((*iv)[1])
5376  {
5377  case ringorder_ws:
5378  case ringorder_Ws:
5379  typ=-1; // and continue
5380  case ringorder_wp:
5381  case ringorder_Wp:
5382  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5383  R->block0[n] = last+1;
5384  for (i=2; i<iv->length(); i++)
5385  {
5386  R->wvhdl[n][i-2] = (*iv)[i];
5387  last++;
5388  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5389  }
5390  R->block1[n] = si_min(last,R->N);
5391  break;
5392  case ringorder_ls:
5393  case ringorder_ds:
5394  case ringorder_Ds:
5395  case ringorder_rs:
5396  typ=-1; // and continue
5397  case ringorder_lp:
5398  case ringorder_dp:
5399  case ringorder_Dp:
5400  case ringorder_rp:
5401  R->block0[n] = last+1;
5402  if (iv->length() == 3) last+=(*iv)[2];
5403  else last += (*iv)[0];
5404  R->block1[n] = si_min(last,R->N);
5405  if (rCheckIV(iv)) return TRUE;
5406  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5407  {
5408  if (weights[i]==0) weights[i]=typ;
5409  }
5410  break;
5411 
5412  case ringorder_s: // no 'rank' params!
5413  {
5414 
5415  if(iv->length() > 3)
5416  return TRUE;
5417 
5418  if(iv->length() == 3)
5419  {
5420  const int s = (*iv)[2];
5421  R->block0[n] = s;
5422  R->block1[n] = s;
5423  }
5424  break;
5425  }
5426  case ringorder_IS:
5427  {
5428  if(iv->length() != 3) return TRUE;
5429 
5430  const int s = (*iv)[2];
5431 
5432  if( 1 < s || s < -1 ) return TRUE;
5433 
5434  R->block0[n] = s;
5435  R->block1[n] = s;
5436  break;
5437  }
5438  case ringorder_S:
5439  case ringorder_c:
5440  case ringorder_C:
5441  {
5442  if (rCheckIV(iv)) return TRUE;
5443  break;
5444  }
5445  case ringorder_aa:
5446  case ringorder_a:
5447  {
5448  R->block0[n] = last+1;
5449  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5450  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5451  for (i=2; i<iv->length(); i++)
5452  {
5453  R->wvhdl[n][i-2]=(*iv)[i];
5454  last++;
5455  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5456  }
5457  last=R->block0[n]-1;
5458  break;
5459  }
5460  case ringorder_am:
5461  {
5462  R->block0[n] = last+1;
5463  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5464  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5465  if (R->block1[n]- R->block0[n]+2>=iv->length())
5466  WarnS("missing module weights");
5467  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5468  {
5469  R->wvhdl[n][i-2]=(*iv)[i];
5470  last++;
5471  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5472  }
5473  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5474  for (; i<iv->length(); i++)
5475  {
5476  R->wvhdl[n][i-1]=(*iv)[i];
5477  }
5478  last=R->block0[n]-1;
5479  break;
5480  }
5481  case ringorder_a64:
5482  {
5483  R->block0[n] = last+1;
5484  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5485  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5486  int64 *w=(int64 *)R->wvhdl[n];
5487  for (i=2; i<iv->length(); i++)
5488  {
5489  w[i-2]=(*iv)[i];
5490  last++;
5491  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5492  }
5493  last=R->block0[n]-1;
5494  break;
5495  }
5496  case ringorder_M:
5497  {
5498  int Mtyp=rTypeOfMatrixOrder(iv);
5499  if (Mtyp==0) return TRUE;
5500  if (Mtyp==-1) typ = -1;
5501 
5502  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5503  for (i=2; i<iv->length();i++)
5504  R->wvhdl[n][i-2]=(*iv)[i];
5505 
5506  R->block0[n] = last+1;
5507  last += (int)sqrt((double)(iv->length()-2));
5508  R->block1[n] = si_min(last,R->N);
5509  for(i=R->block1[n];i>=R->block0[n];i--)
5510  {
5511  if (weights[i]==0) weights[i]=typ;
5512  }
5513  break;
5514  }
5515 
5516  case ringorder_no:
5517  R->order[n] = ringorder_unspec;
5518  return TRUE;
5519 
5520  default:
5521  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5522  R->order[n] = ringorder_unspec;
5523  return TRUE;
5524  }
5525  }
5526  if (last>R->N)
5527  {
5528  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5529  R->N,last);
5530  return TRUE;
5531  }
5532  sl=sl->next;
5533  }
5534  // find OrdSgn:
5535  R->OrdSgn = 1;
5536  for(i=1;i<=R->N;i++)
5537  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5538  omFree(weights);
5539 
5540  // check for complete coverage
5541  while ( n >= 0 && (
5542  (R->order[n]==ringorder_c)
5543  || (R->order[n]==ringorder_C)
5544  || (R->order[n]==ringorder_s)
5545  || (R->order[n]==ringorder_S)
5546  || (R->order[n]==ringorder_IS)
5547  )) n--;
5548 
5549  assume( n >= 0 );
5550 
5551  if (R->block1[n] != R->N)
5552  {
5553  if (((R->order[n]==ringorder_dp) ||
5554  (R->order[n]==ringorder_ds) ||
5555  (R->order[n]==ringorder_Dp) ||
5556  (R->order[n]==ringorder_Ds) ||
5557  (R->order[n]==ringorder_rp) ||
5558  (R->order[n]==ringorder_rs) ||
5559  (R->order[n]==ringorder_lp) ||
5560  (R->order[n]==ringorder_ls))
5561  &&
5562  R->block0[n] <= R->N)
5563  {
5564  R->block1[n] = R->N;
5565  }
5566  else
5567  {
5568  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5569  R->N,R->block1[n]);
5570  return TRUE;
5571  }
5572  }
5573  return FALSE;
5574 }
long int64
Definition: auxiliary.h:68
for(int i=0;i<=n;i++) degsf[i]
Definition: cfEzgcd.cc:72
STATIC_VAR poly last
Definition: hdegree.cc:1173
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition: ipshell.cc:5185
int rTypeOfMatrixOrder(const intvec *order)
Definition: ring.cc:185
BOOLEAN rCheckIV(const intvec *iv)
Definition: ring.cc:175
@ ringorder_no
Definition: ring.h:69

◆ rSubring()

ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 6008 of file ipshell.cc.

6009 {
6010  ring R = rCopy0(org_ring);
6011  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
6012  int n = rBlocks(org_ring), i=0, j;
6013 
6014  /* names and number of variables-------------------------------------*/
6015  {
6016  int l=rv->listLength();
6017  if (l>MAX_SHORT)
6018  {
6019  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
6020  goto rInitError;
6021  }
6022  R->N = l; /*rv->listLength();*/
6023  }
6024  omFree(R->names);
6025  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
6026  if (rSleftvList2StringArray(rv, R->names))
6027  {
6028  WerrorS("name of ring variable expected");
6029  goto rInitError;
6030  }
6031 
6032  /* check names for subring in org_ring ------------------------- */
6033  {
6034  i=0;
6035 
6036  for(j=0;j<R->N;j++)
6037  {
6038  for(;i<org_ring->N;i++)
6039  {
6040  if (strcmp(org_ring->names[i],R->names[j])==0)
6041  {
6042  perm[i+1]=j+1;
6043  break;
6044  }
6045  }
6046  if (i>org_ring->N)
6047  {
6048  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
6049  break;
6050  }
6051  }
6052  }
6053  //Print("perm=");
6054  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
6055  /* ordering -------------------------------------------------------------*/
6056 
6057  for(i=0;i<n;i++)
6058  {
6059  int min_var=-1;
6060  int max_var=-1;
6061  for(j=R->block0[i];j<=R->block1[i];j++)
6062  {
6063  if (perm[j]>0)
6064  {
6065  if (min_var==-1) min_var=perm[j];
6066  max_var=perm[j];
6067  }
6068  }
6069  if (min_var!=-1)
6070  {
6071  //Print("block %d: old %d..%d, now:%d..%d\n",
6072  // i,R->block0[i],R->block1[i],min_var,max_var);
6073  R->block0[i]=min_var;
6074  R->block1[i]=max_var;
6075  if (R->wvhdl[i]!=NULL)
6076  {
6077  omFree(R->wvhdl[i]);
6078  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
6079  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
6080  {
6081  if (perm[j]>0)
6082  {
6083  R->wvhdl[i][perm[j]-R->block0[i]]=
6084  org_ring->wvhdl[i][j-org_ring->block0[i]];
6085  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
6086  }
6087  }
6088  }
6089  }
6090  else
6091  {
6092  if(R->block0[i]>0)
6093  {
6094  //Print("skip block %d\n",i);
6095  R->order[i]=ringorder_unspec;
6096  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
6097  R->wvhdl[i]=NULL;
6098  }
6099  //else Print("keep block %d\n",i);
6100  }
6101  }
6102  i=n-1;
6103  while(i>0)
6104  {
6105  // removed unneded blocks
6106  if(R->order[i-1]==ringorder_unspec)
6107  {
6108  for(j=i;j<=n;j++)
6109  {
6110  R->order[j-1]=R->order[j];
6111  R->block0[j-1]=R->block0[j];
6112  R->block1[j-1]=R->block1[j];
6113  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
6114  R->wvhdl[j-1]=R->wvhdl[j];
6115  }
6116  R->order[n]=ringorder_unspec;
6117  n--;
6118  }
6119  i--;
6120  }
6121  n=rBlocks(org_ring)-1;
6122  while (R->order[n]==0) n--;
6123  while (R->order[n]==ringorder_unspec) n--;
6124  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6125  if (R->block1[n] != R->N)
6126  {
6127  if (((R->order[n]==ringorder_dp) ||
6128  (R->order[n]==ringorder_ds) ||
6129  (R->order[n]==ringorder_Dp) ||
6130  (R->order[n]==ringorder_Ds) ||
6131  (R->order[n]==ringorder_rp) ||
6132  (R->order[n]==ringorder_rs) ||
6133  (R->order[n]==ringorder_lp) ||
6134  (R->order[n]==ringorder_ls))
6135  &&
6136  R->block0[n] <= R->N)
6137  {
6138  R->block1[n] = R->N;
6139  }
6140  else
6141  {
6142  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6143  R->N,R->block1[n],n);
6144  return NULL;
6145  }
6146  }
6147  omFree(perm);
6148  // find OrdSgn:
6149  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6150  //for(i=1;i<=R->N;i++)
6151  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6152  //omFree(weights);
6153  // Complete the initialization
6154  if (rComplete(R,1))
6155  goto rInitError;
6156 
6157  rTest(R);
6158 
6159  if (rv != NULL) rv->CleanUp();
6160 
6161  return R;
6162 
6163  // error case:
6164  rInitError:
6165  if (R != NULL) rDelete(R);
6166  if (rv != NULL) rv->CleanUp();
6167  return NULL;
6168 }
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition: ring.cc:1421

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

1105 {
1106  int i;
1107  indset save;
1109 
1110  hexist = hInit(S, Q, &hNexist);
1111  if (hNexist == 0)
1112  {
1113  intvec *iv=new intvec(rVar(currRing));
1114  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1115  res->Init(1);
1116  res->m[0].rtyp=INTVEC_CMD;
1117  res->m[0].data=(intvec*)iv;
1118  return res;
1119  }
1120  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1121  hMu = 0;
1122  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1123  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1124  hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1125  hrad = hexist;
1126  hNrad = hNexist;
1127  radmem = hCreate(rVar(currRing) - 1);
1128  hCo = rVar(currRing) + 1;
1129  hNvar = rVar(currRing);
1130  hRadical(hrad, &hNrad, hNvar);
1131  hSupp(hrad, hNrad, hvar, &hNvar);
1132  if (hNvar)
1133  {
1134  hCo = hNvar;
1135  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1136  hLexR(hrad, hNrad, hvar, hNvar);
1138  }
1139  if (hCo && (hCo < rVar(currRing)))
1140  {
1142  }
1143  if (hMu!=0)
1144  {
1145  ISet = save;
1146  hMu2 = 0;
1147  if (all && (hCo+1 < rVar(currRing)))
1148  {
1151  i=hMu+hMu2;
1152  res->Init(i);
1153  if (hMu2 == 0)
1154  {
1156  }
1157  }
1158  else
1159  {
1160  res->Init(hMu);
1161  }
1162  for (i=0;i<hMu;i++)
1163  {
1164  res->m[i].data = (void *)save->set;
1165  res->m[i].rtyp = INTVEC_CMD;
1166  ISet = save;
1167  save = save->nx;
1169  }
1170  omFreeBin((ADDRESS)save, indlist_bin);
1171  if (hMu2 != 0)
1172  {
1173  save = JSet;
1174  for (i=hMu;i<hMu+hMu2;i++)
1175  {
1176  res->m[i].data = (void *)save->set;
1177  res->m[i].rtyp = INTVEC_CMD;
1178  JSet = save;
1179  save = save->nx;
1181  }
1182  omFreeBin((ADDRESS)save, indlist_bin);
1183  }
1184  }
1185  else
1186  {
1187  res->Init(0);
1189  }
1190  hKill(radmem, rVar(currRing) - 1);
1191  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1192  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1193  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1195  return res;
1196 }
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:384
VAR omBin indlist_bin
Definition: hdegree.cc:29
VAR int hMu2
Definition: hdegree.cc:27
VAR int hCo
Definition: hdegree.cc:27
VAR indset ISet
Definition: hdegree.cc:353
VAR long hMu
Definition: hdegree.cc:28
VAR indset JSet
Definition: hdegree.cc:353
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:35
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:564
monf hCreate(int Nvar)
Definition: hutil.cc:996
VAR varset hvar
Definition: hutil.cc:18
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1010
VAR int hNexist
Definition: hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:140
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:621
VAR scfmon hwork
Definition: hutil.cc:16
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:174
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:565
VAR scmon hpure
Definition: hutil.cc:17
VAR scfmon hrad
Definition: hutil.cc:16
VAR monf radmem
Definition: hutil.cc:21
VAR int hNpure
Definition: hutil.cc:19
VAR int hNrad
Definition: hutil.cc:19
scfmon hInit(ideal S, ideal Q, int *Nexist)
Definition: hutil.cc:31
VAR scfmon hexist
Definition: hutil.cc:16
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:411
VAR int hNvar
Definition: hutil.cc:19
scmon * scfmon
Definition: hutil.h:15
indlist * indset
Definition: hutil.h:28
int * varset
Definition: hutil.h:16
int * scmon
Definition: hutil.h:14
STATIC_VAR jList * Q
Definition: janet.cc:30

◆ semicProc()

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

Definition at line 4550 of file ipshell.cc.

4551 {
4552  sleftv tmp;
4553  tmp.Init();
4554  tmp.rtyp=INT_CMD;
4555  /* tmp.data = (void *)0; -- done by Init */
4556 
4557  return semicProc3(res,u,v,&tmp);
4558 }
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4510

◆ semicProc3()

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

Definition at line 4510 of file ipshell.cc.

4511 {
4512  semicState state;
4513  BOOLEAN qh=(((int)(long)w->Data())==1);
4514 
4515  // -----------------
4516  // check arguments
4517  // -----------------
4518 
4519  lists l1 = (lists)u->Data( );
4520  lists l2 = (lists)v->Data( );
4521 
4522  if( (state=list_is_spectrum( l1 ))!=semicOK )
4523  {
4524  WerrorS( "first argument is not a spectrum" );
4525  list_error( state );
4526  }
4527  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4528  {
4529  WerrorS( "second argument is not a spectrum" );
4530  list_error( state );
4531  }
4532  else
4533  {
4534  spectrum s1= spectrumFromList( l1 );
4535  spectrum s2= spectrumFromList( l2 );
4536 
4537  res->rtyp = INT_CMD;
4538  if (qh)
4539  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4540  else
4541  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4542  }
4543 
4544  // -----------------
4545  // check status
4546  // -----------------
4547 
4548  return (state!=semicOK);
4549 }
Definition: semic.h:64
int mult_spectrum(spectrum &)
Definition: semic.cc:396
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
void list_error(semicState state)
Definition: ipshell.cc:3467
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3383
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4252

◆ spaddProc()

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

Definition at line 4427 of file ipshell.cc.

4428 {
4429  semicState state;
4430 
4431  // -----------------
4432  // check arguments
4433  // -----------------
4434 
4435  lists l1 = (lists)first->Data( );
4436  lists l2 = (lists)second->Data( );
4437 
4438  if( (state=list_is_spectrum( l1 )) != semicOK )
4439  {
4440  WerrorS( "first argument is not a spectrum:" );
4441  list_error( state );
4442  }
4443  else if( (state=list_is_spectrum( l2 )) != semicOK )
4444  {
4445  WerrorS( "second argument is not a spectrum:" );
4446  list_error( state );
4447  }
4448  else
4449  {
4450  spectrum s1= spectrumFromList ( l1 );
4451  spectrum s2= spectrumFromList ( l2 );
4452  spectrum sum( s1+s2 );
4453 
4454  result->rtyp = LIST_CMD;
4455  result->data = (char*)(getList(sum));
4456  }
4457 
4458  return (state!=semicOK);
4459 }
lists getList(spectrum &spec)
Definition: ipshell.cc:3395

◆ spectrumCompute()

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

Definition at line 3809 of file ipshell.cc.

3810 {
3811  int i;
3812 
3813  #ifdef SPECTRUM_DEBUG
3814  #ifdef SPECTRUM_PRINT
3815  #ifdef SPECTRUM_IOSTREAM
3816  cout << "spectrumCompute\n";
3817  if( fast==0 ) cout << " no optimization" << endl;
3818  if( fast==1 ) cout << " weight optimization" << endl;
3819  if( fast==2 ) cout << " symmetry optimization" << endl;
3820  #else
3821  fputs( "spectrumCompute\n",stdout );
3822  if( fast==0 ) fputs( " no optimization\n", stdout );
3823  if( fast==1 ) fputs( " weight optimization\n", stdout );
3824  if( fast==2 ) fputs( " symmetry optimization\n", stdout );
3825  #endif
3826  #endif
3827  #endif
3828 
3829  // ----------------------
3830  // check if h is zero
3831  // ----------------------
3832 
3833  if( h==(poly)NULL )
3834  {
3835  return spectrumZero;
3836  }
3837 
3838  // ----------------------------------
3839  // check if h has a constant term
3840  // ----------------------------------
3841 
3842  if( hasConstTerm( h, currRing ) )
3843  {
3844  return spectrumBadPoly;
3845  }
3846 
3847  // --------------------------------
3848  // check if h has a linear term
3849  // --------------------------------
3850 
3851  if( hasLinearTerm( h, currRing ) )
3852  {
3853  *L = (lists)omAllocBin( slists_bin);
3854  (*L)->Init( 1 );
3855  (*L)->m[0].rtyp = INT_CMD; // milnor number
3856  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3857 
3858  return spectrumNoSingularity;
3859  }
3860 
3861  // ----------------------------------
3862  // compute the jacobi ideal of (h)
3863  // ----------------------------------
3864 
3865  ideal J = NULL;
3866  J = idInit( rVar(currRing),1 );
3867 
3868  #ifdef SPECTRUM_DEBUG
3869  #ifdef SPECTRUM_PRINT
3870  #ifdef SPECTRUM_IOSTREAM
3871  cout << "\n computing the Jacobi ideal...\n";
3872  #else
3873  fputs( "\n computing the Jacobi ideal...\n",stdout );
3874  #endif
3875  #endif
3876  #endif
3877 
3878  for( i=0; i<rVar(currRing); i++ )
3879  {
3880  J->m[i] = pDiff( h,i+1); //j );
3881 
3882  #ifdef SPECTRUM_DEBUG
3883  #ifdef SPECTRUM_PRINT
3884  #ifdef SPECTRUM_IOSTREAM
3885  cout << " ";
3886  #else
3887  fputs(" ", stdout );
3888  #endif
3889  pWrite( J->m[i] );
3890  #endif
3891  #endif
3892  }
3893 
3894  // --------------------------------------------
3895  // compute a standard basis stdJ of jac(h)
3896  // --------------------------------------------
3897 
3898  #ifdef SPECTRUM_DEBUG
3899  #ifdef SPECTRUM_PRINT
3900  #ifdef SPECTRUM_IOSTREAM
3901  cout << endl;
3902  cout << " computing a standard basis..." << endl;
3903  #else
3904  fputs( "\n", stdout );
3905  fputs( " computing a standard basis...\n", stdout );
3906  #endif
3907  #endif
3908  #endif
3909 
3910  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3911  idSkipZeroes( stdJ );
3912 
3913  #ifdef SPECTRUM_DEBUG
3914  #ifdef SPECTRUM_PRINT
3915  for( i=0; i<IDELEMS(stdJ); i++ )
3916  {
3917  #ifdef SPECTRUM_IOSTREAM
3918  cout << " ";
3919  #else
3920  fputs( " ",stdout );
3921  #endif
3922 
3923  pWrite( stdJ->m[i] );
3924  }
3925  #endif
3926  #endif
3927 
3928  idDelete( &J );
3929 
3930  // ------------------------------------------
3931  // check if the h has a singularity
3932  // ------------------------------------------
3933 
3934  if( hasOne( stdJ, currRing ) )
3935  {
3936  // -------------------------------
3937  // h is smooth in the origin
3938  // return only the Milnor number
3939  // -------------------------------
3940 
3941  *L = (lists)omAllocBin( slists_bin);
3942  (*L)->Init( 1 );
3943  (*L)->m[0].rtyp = INT_CMD; // milnor number
3944  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3945 
3946  return spectrumNoSingularity;
3947  }
3948 
3949  // ------------------------------------------
3950  // check if the singularity h is isolated
3951  // ------------------------------------------
3952 
3953  for( i=rVar(currRing); i>0; i-- )
3954  {
3955  if( hasAxis( stdJ,i, currRing )==FALSE )
3956  {
3957  return spectrumNotIsolated;
3958  }
3959  }
3960 
3961  // ------------------------------------------
3962  // compute the highest corner hc of stdJ
3963  // ------------------------------------------
3964 
3965  #ifdef SPECTRUM_DEBUG
3966  #ifdef SPECTRUM_PRINT
3967  #ifdef SPECTRUM_IOSTREAM
3968  cout << "\n computing the highest corner...\n";
3969  #else
3970  fputs( "\n computing the highest corner...\n", stdout );
3971  #endif
3972  #endif
3973  #endif
3974 
3975  poly hc = (poly)NULL;
3976 
3977  scComputeHC( stdJ,currRing->qideal, 0,hc );
3978 
3979  if( hc!=(poly)NULL )
3980  {
3981  pGetCoeff(hc) = nInit(1);
3982 
3983  for( i=rVar(currRing); i>0; i-- )
3984  {
3985  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3986  }
3987  pSetm( hc );
3988  }
3989  else
3990  {
3991  return spectrumNoHC;
3992  }
3993 
3994  #ifdef SPECTRUM_DEBUG
3995  #ifdef SPECTRUM_PRINT
3996  #ifdef SPECTRUM_IOSTREAM
3997  cout << " ";
3998  #else
3999  fputs( " ", stdout );
4000  #endif
4001  pWrite( hc );
4002  #endif
4003  #endif
4004 
4005  // ----------------------------------------
4006  // compute the Newton polygon nph of h
4007  // ----------------------------------------
4008 
4009  #ifdef SPECTRUM_DEBUG
4010  #ifdef SPECTRUM_PRINT
4011  #ifdef SPECTRUM_IOSTREAM
4012  cout << "\n computing the newton polygon...\n";
4013  #else
4014  fputs( "\n computing the newton polygon...\n", stdout );
4015  #endif
4016  #endif
4017  #endif
4018 
4019  newtonPolygon nph( h, currRing );
4020 
4021  #ifdef SPECTRUM_DEBUG
4022  #ifdef SPECTRUM_PRINT
4023  cout << nph;
4024  #endif
4025  #endif
4026 
4027  // -----------------------------------------------
4028  // compute the weight corner wc of (stdj,nph)
4029  // -----------------------------------------------
4030 
4031  #ifdef SPECTRUM_DEBUG
4032  #ifdef SPECTRUM_PRINT
4033  #ifdef SPECTRUM_IOSTREAM
4034  cout << "\n computing the weight corner...\n";
4035  #else
4036  fputs( "\n computing the weight corner...\n", stdout );
4037  #endif
4038  #endif
4039  #endif
4040 
4041  poly wc = ( fast==0 ? pCopy( hc ) :
4042  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
4043  /* fast==2 */computeWC( nph,
4044  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
4045 
4046  #ifdef SPECTRUM_DEBUG
4047  #ifdef SPECTRUM_PRINT
4048  #ifdef SPECTRUM_IOSTREAM
4049  cout << " ";
4050  #else
4051  fputs( " ", stdout );
4052  #endif
4053  pWrite( wc );
4054  #endif
4055  #endif
4056 
4057  // -------------
4058  // compute NF
4059  // -------------
4060 
4061  #ifdef SPECTRUM_DEBUG
4062  #ifdef SPECTRUM_PRINT
4063  #ifdef SPECTRUM_IOSTREAM
4064  cout << "\n computing NF...\n" << endl;
4065  #else
4066  fputs( "\n computing NF...\n", stdout );
4067  #endif
4068  #endif
4069  #endif
4070 
4071  spectrumPolyList NF( &nph );
4072 
4073  computeNF( stdJ,hc,wc,&NF, currRing );
4074 
4075  #ifdef SPECTRUM_DEBUG
4076  #ifdef SPECTRUM_PRINT
4077  cout << NF;
4078  #ifdef SPECTRUM_IOSTREAM
4079  cout << endl;
4080  #else
4081  fputs( "\n", stdout );
4082  #endif
4083  #endif
4084  #endif
4085 
4086  // ----------------------------
4087  // compute the spectrum of h
4088  // ----------------------------
4089 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4090 
4091  return spectrumStateFromList(NF, L, fast );
4092 }
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition: ipshell.cc:3568
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:2433
void idSkipZeroes(ideal ide)
gives an ideal/module the minimal possible size
BOOLEAN hasAxis(ideal J, int k, const ring r)
Definition: spectrum.cc:81
int hasOne(ideal J, const ring r)
Definition: spectrum.cc:96
poly computeWC(const newtonPolygon &np, Rational max_weight, const ring r)
Definition: spectrum.cc:142
void computeNF(ideal stdJ, poly hc, poly wc, spectrumPolyList *NF, const ring r)
Definition: spectrum.cc:309
BOOLEAN hasLinearTerm(poly h, const ring r)
Definition: spectrum.h:30
BOOLEAN hasConstTerm(poly h, const ring r)
Definition: spectrum.h:28
@ isNotHomog
Definition: structs.h:36

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4183 of file ipshell.cc.

4184 {
4185  spectrumState state = spectrumOK;
4186 
4187  // -------------------
4188  // check consistency
4189  // -------------------
4190 
4191  // check for a local polynomial ring
4192 
4193  if( currRing->OrdSgn != -1 )
4194  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4195  // or should we use:
4196  //if( !ringIsLocal( ) )
4197  {
4198  WerrorS( "only works for local orderings" );
4199  state = spectrumWrongRing;
4200  }
4201  else if( currRing->qideal != NULL )
4202  {
4203  WerrorS( "does not work in quotient rings" );
4204  state = spectrumWrongRing;
4205  }
4206  else
4207  {
4208  lists L = (lists)NULL;
4209  int flag = 2; // symmetric optimization
4210 
4211  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4212 
4213  if( state==spectrumOK )
4214  {
4215  result->rtyp = LIST_CMD;
4216  result->data = (char*)L;
4217  }
4218  else
4219  {
4220  spectrumPrintError(state);
4221  }
4222  }
4223 
4224  return (state!=spectrumOK);
4225 }
spectrumState
Definition: ipshell.cc:3550
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3809
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4101

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3383 of file ipshell.cc.

3384 {
3385  spectrum result;
3386  copy_deep( result, l );
3387  return result;
3388 }
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3359

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4101 of file ipshell.cc.

4102 {
4103  switch( state )
4104  {
4105  case spectrumZero:
4106  WerrorS( "polynomial is zero" );
4107  break;
4108  case spectrumBadPoly:
4109  WerrorS( "polynomial has constant term" );
4110  break;
4111  case spectrumNoSingularity:
4112  WerrorS( "not a singularity" );
4113  break;
4114  case spectrumNotIsolated:
4115  WerrorS( "the singularity is not isolated" );
4116  break;
4117  case spectrumNoHC:
4118  WerrorS( "highest corner cannot be computed" );
4119  break;
4120  case spectrumDegenerate:
4121  WerrorS( "principal part is degenerate" );
4122  break;
4123  case spectrumOK:
4124  break;
4125 
4126  default:
4127  WerrorS( "unknown error occurred" );
4128  break;
4129  }
4130 }

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4132 of file ipshell.cc.

4133 {
4134  spectrumState state = spectrumOK;
4135 
4136  // -------------------
4137  // check consistency
4138  // -------------------
4139 
4140  // check for a local ring
4141 
4142  if( !ringIsLocal(currRing ) )
4143  {
4144  WerrorS( "only works for local orderings" );
4145  state = spectrumWrongRing;
4146  }
4147 
4148  // no quotient rings are allowed
4149 
4150  else if( currRing->qideal != NULL )
4151  {
4152  WerrorS( "does not work in quotient rings" );
4153  state = spectrumWrongRing;
4154  }
4155  else
4156  {
4157  lists L = (lists)NULL;
4158  int flag = 1; // weight corner optimization is safe
4159 
4160  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4161 
4162  if( state==spectrumOK )
4163  {
4164  result->rtyp = LIST_CMD;
4165  result->data = (char*)L;
4166  }
4167  else
4168  {
4169  spectrumPrintError(state);
4170  }
4171  }
4172 
4173  return (state!=spectrumOK);
4174 }
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461

◆ spectrumStateFromList()

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

Definition at line 3568 of file ipshell.cc.

3569 {
3570  spectrumPolyNode **node = &speclist.root;
3572 
3573  poly f,tmp;
3574  int found,cmp;
3575 
3576  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3577  ( fast==2 ? 2 : 1 ) );
3578 
3579  Rational weight_prev( 0,1 );
3580 
3581  int mu = 0; // the milnor number
3582  int pg = 0; // the geometrical genus
3583  int n = 0; // number of different spectral numbers
3584  int z = 0; // number of spectral number equal to smax
3585 
3586  while( (*node)!=(spectrumPolyNode*)NULL &&
3587  ( fast==0 || (*node)->weight<=smax ) )
3588  {
3589  // ---------------------------------------
3590  // determine the first normal form which
3591  // contains the monomial node->mon
3592  // ---------------------------------------
3593 
3594  found = FALSE;
3595  search = *node;
3596 
3597  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3598  {
3599  if( search->nf!=(poly)NULL )
3600  {
3601  f = search->nf;
3602 
3603  do
3604  {
3605  // --------------------------------
3606  // look for (*node)->mon in f
3607  // --------------------------------
3608 
3609  cmp = pCmp( (*node)->mon,f );
3610 
3611  if( cmp<0 )
3612  {
3613  f = pNext( f );
3614  }
3615  else if( cmp==0 )
3616  {
3617  // -----------------------------
3618  // we have found a normal form
3619  // -----------------------------
3620 
3621  found = TRUE;
3622 
3623  // normalize coefficient
3624 
3625  number inv = nInvers( pGetCoeff( f ) );
3626  search->nf=__p_Mult_nn( search->nf,inv,currRing );
3627  nDelete( &inv );
3628 
3629  // exchange normal forms
3630 
3631  tmp = (*node)->nf;
3632  (*node)->nf = search->nf;
3633  search->nf = tmp;
3634  }
3635  }
3636  while( cmp<0 && f!=(poly)NULL );
3637  }
3638  search = search->next;
3639  }
3640 
3641  if( found==FALSE )
3642  {
3643  // ------------------------------------------------
3644  // the weight of node->mon is a spectrum number
3645  // ------------------------------------------------
3646 
3647  mu++;
3648 
3649  if( (*node)->weight<=(Rational)1 ) pg++;
3650  if( (*node)->weight==smax ) z++;
3651  if( (*node)->weight>weight_prev ) n++;
3652 
3653  weight_prev = (*node)->weight;
3654  node = &((*node)->next);
3655  }
3656  else
3657  {
3658  // -----------------------------------------------
3659  // determine all other normal form which contain
3660  // the monomial node->mon
3661  // replace for node->mon its normal form
3662  // -----------------------------------------------
3663 
3664  while( search!=(spectrumPolyNode*)NULL )
3665  {
3666  if( search->nf!=(poly)NULL )
3667  {
3668  f = search->nf;
3669 
3670  do
3671  {
3672  // --------------------------------
3673  // look for (*node)->mon in f
3674  // --------------------------------
3675 
3676  cmp = pCmp( (*node)->mon,f );
3677 
3678  if( cmp<0 )
3679  {
3680  f = pNext( f );
3681  }
3682  else if( cmp==0 )
3683  {
3684  search->nf = pSub( search->nf,
3685  __pp_Mult_nn( (*node)->nf,pGetCoeff( f ),currRing ) );
3686  pNorm( search->nf );
3687  }
3688  }
3689  while( cmp<0 && f!=(poly)NULL );
3690  }
3691  search = search->next;
3692  }
3693  speclist.delete_node( node );
3694  }
3695 
3696  }
3697 
3698  // --------------------------------------------------------
3699  // fast computation exploits the symmetry of the spectrum
3700  // --------------------------------------------------------
3701 
3702  if( fast==2 )
3703  {
3704  mu = 2*mu - z;
3705  n = ( z > 0 ? 2*n - 1 : 2*n );
3706  }
3707 
3708  // --------------------------------------------------------
3709  // compute the spectrum numbers with their multiplicities
3710  // --------------------------------------------------------
3711 
3712  intvec *nom = new intvec( n );
3713  intvec *den = new intvec( n );
3714  intvec *mult = new intvec( n );
3715 
3716  int count = 0;
3717  int multiplicity = 1;
3718 
3719  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3720  ( fast==0 || search->weight<=smax );
3721  search=search->next )
3722  {
3723  if( search->next==(spectrumPolyNode*)NULL ||
3724  search->weight<search->next->weight )
3725  {
3726  (*nom) [count] = search->weight.get_num_si( );
3727  (*den) [count] = search->weight.get_den_si( );
3728  (*mult)[count] = multiplicity;
3729 
3730  multiplicity=1;
3731  count++;
3732  }
3733  else
3734  {
3735  multiplicity++;
3736  }
3737  }
3738 
3739  // --------------------------------------------------------
3740  // fast computation exploits the symmetry of the spectrum
3741  // --------------------------------------------------------
3742 
3743  if( fast==2 )
3744  {
3745  int n1,n2;
3746  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3747  {
3748  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3749  (*den) [n2] = (*den)[n1];
3750  (*mult)[n2] = (*mult)[n1];
3751  }
3752  }
3753 
3754  // -----------------------------------
3755  // test if the spectrum is symmetric
3756  // -----------------------------------
3757 
3758  if( fast==0 || fast==1 )
3759  {
3760  int symmetric=TRUE;
3761 
3762  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3763  {
3764  if( (*mult)[n1]!=(*mult)[n2] ||
3765  (*den) [n1]!= (*den)[n2] ||
3766  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3767  {
3768  symmetric = FALSE;
3769  }
3770  }
3771 
3772  if( symmetric==FALSE )
3773  {
3774  // ---------------------------------------------
3775  // the spectrum is not symmetric => degenerate
3776  // principal part
3777  // ---------------------------------------------
3778 
3779  *L = (lists)omAllocBin( slists_bin);
3780  (*L)->Init( 1 );
3781  (*L)->m[0].rtyp = INT_CMD; // milnor number
3782  (*L)->m[0].data = (void*)(long)mu;
3783 
3784  return spectrumDegenerate;
3785  }
3786  }
3787 
3788  *L = (lists)omAllocBin( slists_bin);
3789 
3790  (*L)->Init( 6 );
3791 
3792  (*L)->m[0].rtyp = INT_CMD; // milnor number
3793  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3794  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3795  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3796  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3797  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3798 
3799  (*L)->m[0].data = (void*)(long)mu;
3800  (*L)->m[1].data = (void*)(long)pg;
3801  (*L)->m[2].data = (void*)(long)n;
3802  (*L)->m[3].data = (void*)nom;
3803  (*L)->m[4].data = (void*)den;
3804  (*L)->m[5].data = (void*)mult;
3805 
3806  return spectrumOK;
3807 }
FILE * f
Definition: checklibs.c:9
spectrumPolyNode * root
Definition: splist.h:60
void delete_node(spectrumPolyNode **)
Definition: splist.cc:256
bool found
Definition: facFactorize.cc:55
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
STATIC_VAR int * multiplicity
#define pNext(p)
Definition: monomials.h:36
#define nInvers(a)
Definition: numbers.h:33
#define __pp_Mult_nn(p, n, r)
Definition: p_polys.h:1004
#define __p_Mult_nn(p, n, r)
Definition: p_polys.h:973
void pNorm(poly p)
Definition: polys.h:363
#define pSub(a, b)
Definition: polys.h:287
#define pCmp(p1, p2)
pCmp: args may be NULL returns: (p2==NULL ? 1 : (p1 == NULL ? -1 : p_LmCmp(p1, p2)))
Definition: polys.h:115

◆ spmulProc()

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

Definition at line 4469 of file ipshell.cc.

4470 {
4471  semicState state;
4472 
4473  // -----------------
4474  // check arguments
4475  // -----------------
4476 
4477  lists l = (lists)first->Data( );
4478  int k = (int)(long)second->Data( );
4479 
4480  if( (state=list_is_spectrum( l ))!=semicOK )
4481  {
4482  WerrorS( "first argument is not a spectrum" );
4483  list_error( state );
4484  }
4485  else if( k < 0 )
4486  {
4487  WerrorS( "second argument should be positive" );
4488  state = semicMulNegative;
4489  }
4490  else
4491  {
4493  spectrum product( k*s );
4494 
4495  result->rtyp = LIST_CMD;
4496  result->data = (char*)getList(product);
4497  }
4498 
4499  return (state!=semicOK);
4500 }

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3171 of file ipshell.cc.

3172 {
3173  sleftv tmp;
3174  tmp.Init();
3175  tmp.rtyp=INT_CMD;
3176  tmp.data=(void *)1;
3177  return syBetti2(res,u,&tmp);
3178 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3148

◆ syBetti2()

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

Definition at line 3148 of file ipshell.cc.

3149 {
3150  syStrategy syzstr=(syStrategy)u->Data();
3151 
3152  BOOLEAN minim=(int)(long)w->Data();
3153  int row_shift=0;
3154  int add_row_shift=0;
3155  intvec *weights=NULL;
3156  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3157  if (ww!=NULL)
3158  {
3159  weights=ivCopy(ww);
3160  add_row_shift = ww->min_in();
3161  (*weights) -= add_row_shift;
3162  }
3163 
3164  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3165  //row_shift += add_row_shift;
3166  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3167  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3168 
3169  return FALSE;
3170 }
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1755
ssyStrategy * syStrategy
Definition: syz.h:35

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3255 of file ipshell.cc.

3256 {
3257  int typ0;
3259 
3260  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3261  if (fr != NULL)
3262  {
3263 
3264  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3265  for (int i=result->length-1;i>=0;i--)
3266  {
3267  if (fr[i]!=NULL)
3268  result->fullres[i] = idCopy(fr[i]);
3269  }
3270  result->list_length=result->length;
3271  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3272  }
3273  else
3274  {
3275  omFreeSize(result, sizeof(ssyStrategy));
3276  result = NULL;
3277  }
3278  return result;
3279 }

◆ syConvRes()

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

Definition at line 3183 of file ipshell.cc.

3184 {
3185  resolvente fullres = syzstr->fullres;
3186  resolvente minres = syzstr->minres;
3187 
3188  const int length = syzstr->length;
3189 
3190  if ((fullres==NULL) && (minres==NULL))
3191  {
3192  if (syzstr->hilb_coeffs==NULL)
3193  { // La Scala
3194  fullres = syReorder(syzstr->res, length, syzstr);
3195  }
3196  else
3197  { // HRES
3198  minres = syReorder(syzstr->orderedRes, length, syzstr);
3199  syKillEmptyEntres(minres, length);
3200  }
3201  }
3202 
3203  resolvente tr;
3204  int typ0=IDEAL_CMD;
3205 
3206  if (minres!=NULL)
3207  tr = minres;
3208  else
3209  tr = fullres;
3210 
3211  resolvente trueres=NULL;
3212  intvec ** w=NULL;
3213 
3214  if (length>0)
3215  {
3216  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3217  for (int i=length-1;i>=0;i--)
3218  {
3219  if (tr[i]!=NULL)
3220  {
3221  trueres[i] = idCopy(tr[i]);
3222  }
3223  }
3224  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3225  typ0 = MODUL_CMD;
3226  if (syzstr->weights!=NULL)
3227  {
3228  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3229  for (int i=length-1;i>=0;i--)
3230  {
3231  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3232  }
3233  }
3234  }
3235 
3236  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3237  w, add_row_shift);
3238 
3239  if (toDel)
3240  syKillComputation(syzstr);
3241  else
3242  {
3243  if( fullres != NULL && syzstr->fullres == NULL )
3244  syzstr->fullres = fullres;
3245 
3246  if( minres != NULL && syzstr->minres == NULL )
3247  syzstr->minres = minres;
3248  }
3249  return li;
3250 }
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
intvec ** hilb_coeffs
Definition: syz.h:46
resolvente minres
Definition: syz.h:58
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1495
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1641
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2199
short list_length
Definition: syz.h:62
resolvente res
Definition: syz.h:47
resolvente fullres
Definition: syz.h:57
intvec ** weights
Definition: syz.h:45
resolvente orderedRes
Definition: syz.h:48
int length
Definition: syz.h:60

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3284 of file ipshell.cc.

3285 {
3286  int typ0;
3288 
3289  resolvente fr = liFindRes(li,&(result->length),&typ0);
3290  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3291  for (int i=result->length-1;i>=0;i--)
3292  {
3293  if (fr[i]!=NULL)
3294  result->minres[i] = idCopy(fr[i]);
3295  }
3296  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3297  return result;
3298 }

◆ test_cmd()

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  WarnS("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 }
VAR BITSET validOpts
Definition: kstd1.cc:60
VAR BITSET kOptions
Definition: kstd1.cc:45

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 254 of file ipshell.cc.

255 {
256  BOOLEAN oldShortOut = FALSE;
257 
258  if (currRing != NULL)
259  {
260  oldShortOut = currRing->ShortOut;
261  currRing->ShortOut = 1;
262  }
263  int t=v->Typ();
264  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
265  switch (t)
266  {
267  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
268  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
269  ((intvec*)(v->Data()))->cols()); break;
270  case MATRIX_CMD:Print(" %u x %u\n" ,
271  MATROWS((matrix)(v->Data())),
272  MATCOLS((matrix)(v->Data())));break;
273  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
274  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
275 
276  case PROC_CMD:
277  case RING_CMD:
278  case IDEAL_CMD: PrintLn(); break;
279 
280  //case INT_CMD:
281  //case STRING_CMD:
282  //case INTVEC_CMD:
283  //case POLY_CMD:
284  //case VECTOR_CMD:
285  //case PACKAGE_CMD:
286 
287  default:
288  break;
289  }
290  v->Print();
291  if (currRing != NULL)
292  currRing->ShortOut = oldShortOut;
293 }
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:504

Variable Documentation

◆ iiCurrArgs

VAR leftv iiCurrArgs =NULL

Definition at line 80 of file ipshell.cc.

◆ iiCurrProc

VAR idhdl iiCurrProc =NULL

Definition at line 81 of file ipshell.cc.

◆ iiDebugMarker

VAR BOOLEAN iiDebugMarker =TRUE

Definition at line 1063 of file ipshell.cc.

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 84 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 82 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5612 of file ipshell.cc.