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

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3553 of file ipshell.cc.

3554 {
3555  spectrumOK,
3556  spectrumZero,
3562  spectrumNoHC,
3564 };
@ spectrumWrongRing
Definition: ipshell.cc:3561
@ spectrumOK
Definition: ipshell.cc:3555
@ spectrumDegenerate
Definition: ipshell.cc:3560
@ spectrumUnspecErr
Definition: ipshell.cc:3563
@ spectrumNotIsolated
Definition: ipshell.cc:3559
@ spectrumBadPoly
Definition: ipshell.cc:3557
@ spectrumNoSingularity
Definition: ipshell.cc:3558
@ spectrumZero
Definition: ipshell.cc:3556
@ spectrumNoHC
Definition: ipshell.cc:3562

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3363 of file ipshell.cc.

3364 {
3365  spec.mu = (int)(long)(l->m[0].Data( ));
3366  spec.pg = (int)(long)(l->m[1].Data( ));
3367  spec.n = (int)(long)(l->m[2].Data( ));
3368 
3369  spec.copy_new( spec.n );
3370 
3371  intvec *num = (intvec*)l->m[3].Data( );
3372  intvec *den = (intvec*)l->m[4].Data( );
3373  intvec *mul = (intvec*)l->m[5].Data( );
3374 
3375  for( int i=0; i<spec.n; i++ )
3376  {
3377  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3378  spec.w[i] = (*mul)[i];
3379  }
3380 }
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 3399 of file ipshell.cc.

3400 {
3402 
3403  L->Init( 6 );
3404 
3405  intvec *num = new intvec( spec.n );
3406  intvec *den = new intvec( spec.n );
3407  intvec *mult = new intvec( spec.n );
3408 
3409  for( int i=0; i<spec.n; i++ )
3410  {
3411  (*num) [i] = spec.s[i].get_num_si( );
3412  (*den) [i] = spec.s[i].get_den_si( );
3413  (*mult)[i] = spec.w[i];
3414  }
3415 
3416  L->m[0].rtyp = INT_CMD; // milnor number
3417  L->m[1].rtyp = INT_CMD; // geometrical genus
3418  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3419  L->m[3].rtyp = INTVEC_CMD; // numerators
3420  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3421  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3422 
3423  L->m[0].data = (void*)(long)spec.mu;
3424  L->m[1].data = (void*)(long)spec.pg;
3425  L->m[2].data = (void*)(long)spec.n;
3426  L->m[3].data = (void*)num;
3427  L->m[4].data = (void*)den;
3428  L->m[5].data = (void*)mult;
3429 
3430  return L;
3431 }
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 6425 of file ipshell.cc.

6426 {
6427  res->Init();
6428  res->rtyp=a->Typ();
6429  switch (res->rtyp /*a->Typ()*/)
6430  {
6431  case INTVEC_CMD:
6432  case INTMAT_CMD:
6433  return iiApplyINTVEC(res,a,op,proc);
6434  case BIGINTMAT_CMD:
6435  return iiApplyBIGINTMAT(res,a,op,proc);
6436  case IDEAL_CMD:
6437  case MODUL_CMD:
6438  case MATRIX_CMD:
6439  return iiApplyIDEAL(res,a,op,proc);
6440  case LIST_CMD:
6441  return iiApplyLIST(res,a,op,proc);
6442  }
6443  WerrorS("first argument to `apply` must allow an index");
6444  return TRUE;
6445 }
#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:6344
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6386
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6381
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6376

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6376 of file ipshell.cc.

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

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6381 of file ipshell.cc.

6382 {
6383  WerrorS("not implemented");
6384  return TRUE;
6385 }

◆ iiApplyINTVEC()

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

Definition at line 6344 of file ipshell.cc.

6345 {
6346  intvec *aa=(intvec*)a->Data();
6347  sleftv tmp_out;
6348  sleftv tmp_in;
6349  leftv curr=res;
6350  BOOLEAN bo=FALSE;
6351  for(int i=0;i<aa->length(); i++)
6352  {
6353  tmp_in.Init();
6354  tmp_in.rtyp=INT_CMD;
6355  tmp_in.data=(void*)(long)(*aa)[i];
6356  if (proc==NULL)
6357  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6358  else
6359  bo=jjPROC(&tmp_out,proc,&tmp_in);
6360  if (bo)
6361  {
6362  res->CleanUp(currRing);
6363  Werror("apply fails at index %d",i+1);
6364  return TRUE;
6365  }
6366  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6367  else
6368  {
6369  curr->next=(leftv)omAllocBin(sleftv_bin);
6370  curr=curr->next;
6371  memcpy(curr,&tmp_out,sizeof(tmp_out));
6372  }
6373  }
6374  return FALSE;
6375 }
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:9059
EXTERN_VAR omBin sleftv_bin
Definition: ipid.h:145
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1618
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 6386 of file ipshell.cc.

6387 {
6388  lists aa=(lists)a->Data();
6389  if (aa->nr==-1) /* empty list*/
6390  {
6392  l->Init();
6393  res->data=(void *)l;
6394  return FALSE;
6395  }
6396  sleftv tmp_out;
6397  sleftv tmp_in;
6398  leftv curr=res;
6399  BOOLEAN bo=FALSE;
6400  for(int i=0;i<=aa->nr; i++)
6401  {
6402  tmp_in.Init();
6403  tmp_in.Copy(&(aa->m[i]));
6404  if (proc==NULL)
6405  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6406  else
6407  bo=jjPROC(&tmp_out,proc,&tmp_in);
6408  tmp_in.CleanUp();
6409  if (bo)
6410  {
6411  res->CleanUp(currRing);
6412  Werror("apply fails at index %d",i+1);
6413  return TRUE;
6414  }
6415  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6416  else
6417  {
6418  curr->next=(leftv)omAllocBin(sleftv_bin);
6419  curr=curr->next;
6420  memcpy(curr,&tmp_out,sizeof(tmp_out));
6421  }
6422  }
6423  return FALSE;
6424 }
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 6474 of file ipshell.cc.

6475 {
6476  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6477  // find end of s:
6478  int end_s=strlen(s);
6479  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6480  s[end_s+1]='\0';
6481  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6482  sprintf(name,"%s->%s",a,s);
6483  // find start of last expression
6484  int start_s=end_s-1;
6485  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6486  if (start_s<0) // ';' not found
6487  {
6488  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6489  }
6490  else // s[start_s] is ';'
6491  {
6492  s[start_s]='\0';
6493  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6494  }
6495  r->Init();
6496  // now produce procinfo for PROC_CMD:
6497  r->data = (void *)omAlloc0Bin(procinfo_bin);
6498  ((procinfo *)(r->data))->language=LANG_NONE;
6499  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6500  ((procinfo *)r->data)->data.s.body=ss;
6501  omFree(name);
6502  r->rtyp=PROC_CMD;
6503  //r->rtyp=STRING_CMD;
6504  //r->data=ss;
6505  return FALSE;
6506 }
const CanonicalForm int s
Definition: facAbsFact.cc:51
@ 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
int name
New type name for int.
Definition: templateForC.h:21

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6508 of file ipshell.cc.

6509 {
6510  char* ring_name=omStrDup((char*)r->Name());
6511  int t=arg->Typ();
6512  if (t==RING_CMD)
6513  {
6514  sleftv tmp;
6515  tmp.Init();
6516  tmp.rtyp=IDHDL;
6517  idhdl h=rDefault(ring_name);
6518  tmp.data=(char*)h;
6519  if (h!=NULL)
6520  {
6521  tmp.name=h->id;
6522  BOOLEAN b=iiAssign(&tmp,arg);
6523  if (b) return TRUE;
6524  rSetHdl(ggetid(ring_name));
6525  omFree(ring_name);
6526  return FALSE;
6527  }
6528  else
6529  return TRUE;
6530  }
6531  else if (t==CRING_CMD)
6532  {
6533  sleftv tmp;
6534  sleftv n;
6535  n.Init();
6536  n.name=ring_name;
6537  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6538  if (iiAssign(&tmp,arg)) return TRUE;
6539  //Print("create %s\n",r->Name());
6540  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6541  return FALSE;
6542  }
6543  //Print("create %s\n",r->Name());
6544  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6545  return TRUE;// not handled -> error for now
6546 }
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:572
#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:1202
idhdl rDefault(const char *s)
Definition: ipshell.cc:1648
void rSetHdl(idhdl h)
Definition: ipshell.cc:5129
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 1277 of file ipshell.cc.

1278 {
1279  // must be inside a proc, as we simultae an proc_end at the end
1280  if (myynest==0)
1281  {
1282  WerrorS("branchTo can only occur in a proc");
1283  return TRUE;
1284  }
1285  // <string1...stringN>,<proc>
1286  // known: args!=NULL, l>=1
1287  int l=args->listLength();
1288  int ll=0;
1289  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1290  if (ll!=(l-1)) return FALSE;
1291  leftv h=args;
1292  // set up the table for type test:
1293  short *t=(short*)omAlloc(l*sizeof(short));
1294  t[0]=l-1;
1295  int b;
1296  int i;
1297  for(i=1;i<l;i++,h=h->next)
1298  {
1299  if (h->Typ()!=STRING_CMD)
1300  {
1301  omFree(t);
1302  Werror("arg %d is not a string",i);
1303  return TRUE;
1304  }
1305  int tt;
1306  b=IsCmd((char *)h->Data(),tt);
1307  if(b) t[i]=tt;
1308  else
1309  {
1310  omFree(t);
1311  Werror("arg %d is not a type name",i);
1312  return TRUE;
1313  }
1314  }
1315  if (h->Typ()!=PROC_CMD)
1316  {
1317  omFree(t);
1318  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1319  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1320  return TRUE;
1321  }
1322  b=iiCheckTypes(iiCurrArgs,t,0);
1323  omFree(t);
1324  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1325  {
1326  // get the proc:
1327  iiCurrProc=(idhdl)h->data;
1328  idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1329  procinfo * pi=IDPROC(currProc);
1330  // already loaded ?
1331  if( pi->data.s.body==NULL )
1332  {
1334  if (pi->data.s.body==NULL) return TRUE;
1335  }
1336  // set currPackHdl/currPack
1337  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1338  {
1339  currPack=pi->pack;
1342  //Print("set pack=%s\n",IDID(currPackHdl));
1343  }
1344  // see iiAllStart:
1345  BITSET save1=si_opt_1;
1346  BITSET save2=si_opt_2;
1347  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1348  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1349  BOOLEAN err=yyparse();
1350  iiCurrProc=NULL;
1351  si_opt_1=save1;
1352  si_opt_2=save2;
1353  // now save the return-expr.
1355  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1356  iiRETURNEXPR.Init();
1357  // warning about args.:
1358  if (iiCurrArgs!=NULL)
1359  {
1360  if (err==0) Warn("too many arguments for %s",IDID(currProc));
1361  iiCurrArgs->CleanUp();
1363  iiCurrArgs=NULL;
1364  }
1365  // similate proc_end:
1366  // - leave input
1367  void myychangebuffer();
1368  myychangebuffer();
1369  // - set the current buffer to its end (this is a pointer in a buffer,
1370  // not a file ptr) "branchTo" is only valid in proc)
1372  // - kill local vars
1374  // - return
1375  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1376  return (err!=0);
1377  }
1378  return FALSE;
1379 }
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:164
VAR Voice * currentVoice
Definition: fevoices.cc:47
@ 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:9469
VAR package currPack
Definition: ipid.cc:57
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:822
#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:1634
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:6566
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
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:2331
#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 1634 of file ipshell.cc.

1635 {
1636  if (p!=basePack)
1637  {
1638  idhdl t=basePack->idroot;
1639  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1640  if (t==NULL)
1641  {
1642  WarnS("package not found\n");
1643  p=basePack;
1644  }
1645  }
1646 }
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 1590 of file ipshell.cc.

1591 {
1592  if (currRing==NULL)
1593  {
1594  #ifdef SIQ
1595  if (siq<=0)
1596  {
1597  #endif
1598  if (RingDependend(i))
1599  {
1600  WerrorS("no ring active (9)");
1601  return TRUE;
1602  }
1603  #ifdef SIQ
1604  }
1605  #endif
1606  }
1607  return FALSE;
1608 }
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 6566 of file ipshell.cc.

6567 {
6568  int l=0;
6569  if (args==NULL)
6570  {
6571  if (type_list[0]==0) return TRUE;
6572  }
6573  else l=args->listLength();
6574  if (l!=(int)type_list[0])
6575  {
6576  if (report) iiReportTypes(0,l,type_list);
6577  return FALSE;
6578  }
6579  for(int i=1;i<=l;i++,args=args->next)
6580  {
6581  short t=type_list[i];
6582  if (t!=ANY_TYPE)
6583  {
6584  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6585  || (t!=args->Typ()))
6586  {
6587  if (report) iiReportTypes(i,args->Typ(),type_list);
6588  return FALSE;
6589  }
6590  }
6591  }
6592  return TRUE;
6593 }
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6548
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:30
const char * VoiceName()
Definition: fevoices.cc:56
void VoiceBackTrack()
Definition: fevoices.cc:75
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 1202 of file ipshell.cc.

1203 {
1204  BOOLEAN res=FALSE;
1205  BOOLEAN is_qring=FALSE;
1206  const char *id = name->name;
1207 
1208  sy->Init();
1209  if ((name->name==NULL)||(isdigit(name->name[0])))
1210  {
1211  WerrorS("object to declare is not a name");
1212  res=TRUE;
1213  }
1214  else
1215  {
1216  if (root==NULL) return TRUE;
1217  if (*root!=IDROOT)
1218  {
1219  if ((currRing==NULL) || (*root!=currRing->idroot))
1220  {
1221  Werror("can not define `%s` in other package",name->name);
1222  return TRUE;
1223  }
1224  }
1225  if (t==QRING_CMD)
1226  {
1227  t=RING_CMD; // qring is always RING_CMD
1228  is_qring=TRUE;
1229  }
1230 
1231  if (TEST_V_ALLWARN
1232  && (name->rtyp!=0)
1233  && (name->rtyp!=IDHDL)
1234  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1235  {
1236  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1238  }
1239  {
1240  sy->data = (char *)enterid(id,lev,t,root,init_b);
1241  }
1242  if (sy->data!=NULL)
1243  {
1244  sy->rtyp=IDHDL;
1245  currid=sy->name=IDID((idhdl)sy->data);
1246  if (is_qring)
1247  {
1249  }
1250  // name->name=NULL; /* used in enterid */
1251  //sy->e = NULL;
1252  if (name->next!=NULL)
1253  {
1255  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1256  }
1257  }
1258  else res=TRUE;
1259  }
1260  name->CleanUp();
1261  return res;
1262 }
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 1264 of file ipshell.cc.

1265 {
1266  attr at=NULL;
1267  if (iiCurrProc!=NULL)
1268  at=iiCurrProc->attribute->get("default_arg");
1269  if (at==NULL)
1270  return FALSE;
1271  sleftv tmp;
1272  tmp.Init();
1273  tmp.rtyp=at->atyp;
1274  tmp.data=at->CopyA();
1275  return iiAssign(p,&tmp);
1276 }
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 1515 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1538 of file ipshell.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1610 of file ipshell.cc.

1611 {
1612  int i;
1613  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1614  poly po=NULL;
1616  {
1617  scComputeHC(I,currRing->qideal,ak,po);
1618  if (po!=NULL)
1619  {
1620  pGetCoeff(po)=nInit(1);
1621  for (i=rVar(currRing); i>0; i--)
1622  {
1623  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1624  }
1625  pSetComp(po,ak);
1626  pSetm(po);
1627  }
1628  }
1629  else
1630  po=pOne();
1631  return po;
1632 }
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1079
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 1416 of file ipshell.cc.

1417 {
1418  idhdl h=(idhdl)v->data;
1419  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1420  if (IDLEV(h)==0)
1421  {
1422  if ((myynest>0) && (BVERBOSE(V_REDEFINE))) Warn("`%s` is already global",IDID(h));
1423  }
1424  else
1425  {
1426  h=IDROOT->get(v->name,toLev);
1427  idhdl *root=&IDROOT;
1428  if ((h==NULL)&&(currRing!=NULL))
1429  {
1430  h=currRing->idroot->get(v->name,toLev);
1431  root=&currRing->idroot;
1432  }
1433  BOOLEAN keepring=FALSE;
1434  if ((h!=NULL)&&(IDLEV(h)==toLev))
1435  {
1436  if (IDTYP(h)==v->Typ())
1437  {
1438  if ((IDTYP(h)==RING_CMD)
1439  && (v->Data()==IDDATA(h)))
1440  {
1441  rIncRefCnt(IDRING(h));
1442  keepring=TRUE;
1443  IDLEV(h)=toLev;
1444  //WarnS("keepring");
1445  return FALSE;
1446  }
1447  if (BVERBOSE(V_REDEFINE))
1448  {
1449  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1450  }
1451  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1452  killhdl2(h,root,currRing);
1453  }
1454  else
1455  {
1456  WerrorS("object with a different type exists");
1457  return TRUE;
1458  }
1459  }
1460  h=(idhdl)v->data;
1461  IDLEV(h)=toLev;
1462  if (keepring) rDecRefCnt(IDRING(h));
1464  //Print("export %s\n",IDID(h));
1465  }
1466  return FALSE;
1467 }
#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
if(yy_init)
Definition: libparse.cc:1420
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 1469 of file ipshell.cc.

1470 {
1471  idhdl h=(idhdl)v->data;
1472  if(h==NULL)
1473  {
1474  Warn("'%s': no such identifier\n", v->name);
1475  return FALSE;
1476  }
1477  package frompack=v->req_packhdl;
1478  if (frompack==NULL) frompack=currPack;
1479  if ((RingDependend(IDTYP(h)))
1480  || ((IDTYP(h)==LIST_CMD)
1481  && (lRingDependend(IDLIST(h)))
1482  )
1483  )
1484  {
1485  //Print("// ==> Ringdependent set nesting to 0\n");
1486  return (iiInternalExport(v, toLev));
1487  }
1488  else
1489  {
1490  IDLEV(h)=toLev;
1491  v->req_packhdl=rootpack;
1492  if (h==frompack->idroot)
1493  {
1494  frompack->idroot=h->next;
1495  }
1496  else
1497  {
1498  idhdl hh=frompack->idroot;
1499  while ((hh!=NULL) && (hh->next!=h))
1500  hh=hh->next;
1501  if ((hh!=NULL) && (hh->next==h))
1502  hh->next=h->next;
1503  else
1504  {
1505  Werror("`%s` not found",v->Name());
1506  return TRUE;
1507  }
1508  }
1509  h->next=rootpack->idroot;
1510  rootpack->idroot=h;
1511  }
1512  return FALSE;
1513 }
#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:1309
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:488
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:233
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:873
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:818
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1479
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 1380 of file ipshell.cc.

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

◆ 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:135
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 6548 of file ipshell.cc.

6549 {
6550  char buf[250];
6551  buf[0]='\0';
6552  if (nr==0)
6553  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6554  else
6555  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6556  for(int i=1;i<=T[0];i++)
6557  {
6558  strcat(buf,"`");
6559  strcat(buf,Tok2Cmdname(T[i]));
6560  strcat(buf,"`");
6561  if (i<T[0]) strcat(buf,",");
6562  }
6563  WerrorS(buf);
6564 }
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 6595 of file ipshell.cc.

6596 {
6597  if ((source->next==NULL)&&(source->e==NULL))
6598  {
6599  if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6600  {
6601  memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6602  source->Init();
6603  return;
6604  }
6605  if (source->rtyp==IDHDL)
6606  {
6607  if ((IDLEV((idhdl)source->data)==myynest)
6608  &&(IDTYP((idhdl)source->data)!=RING_CMD))
6609  {
6610  iiRETURNEXPR.Init();
6611  iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6612  iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6613  iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6615  IDATTR((idhdl)source->data)=NULL;
6616  IDDATA((idhdl)source->data)=NULL;
6617  source->name=NULL;
6618  source->attribute=NULL;
6619  return;
6620  }
6621  }
6622  }
6623  iiRETURNEXPR.Copy(source);
6624 }
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 6447 of file ipshell.cc.

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

3351 {
3352  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3353  return (res->data==NULL);
3354 }
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1548

◆ jjINT_S_TO_ID()

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

Definition at line 6282 of file ipshell.cc.

6283 {
6284  if (n==0) n=1;
6285  ideal l=idInit(n,1);
6286  int i;
6287  poly p;
6288  for(i=rVar(currRing);i>0;i--)
6289  {
6290  if (e[i]>0)
6291  {
6292  n--;
6293  p=pOne();
6294  pSetExp(p,i,1);
6295  pSetm(p);
6296  l->m[n]=p;
6297  if (n==0) break;
6298  }
6299  }
6300  res->data=(char*)l;
6301  setFlag(res,FLAG_STD);
6302  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6303 }
#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 1618 of file iparith.cc.

1619 {
1620  void *d;
1621  Subexpr e;
1622  int typ;
1623  BOOLEAN t=FALSE;
1624  idhdl tmp_proc=NULL;
1625  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1626  {
1627  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1628  tmp_proc->id="_auto";
1629  tmp_proc->typ=PROC_CMD;
1630  tmp_proc->data.pinf=(procinfo *)u->Data();
1631  tmp_proc->ref=1;
1632  d=u->data; u->data=(void *)tmp_proc;
1633  e=u->e; u->e=NULL;
1634  t=TRUE;
1635  typ=u->rtyp; u->rtyp=IDHDL;
1636  }
1637  BOOLEAN sl;
1638  if (u->req_packhdl==currPack)
1639  sl = iiMake_proc((idhdl)u->data,NULL,v);
1640  else
1641  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1642  if (t)
1643  {
1644  u->rtyp=typ;
1645  u->data=d;
1646  u->e=e;
1647  omFreeSize(tmp_proc,sizeof(idrec));
1648  }
1649  if (sl) return TRUE;
1650  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1651  iiRETURNEXPR.Init();
1652  return FALSE;
1653 }
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 3343 of file ipshell.cc.

3344 {
3345  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3346  (poly)w->CopyD(), currRing);
3347  return errorreported;
3348 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:322
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 6312 of file ipshell.cc.

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6304 of file ipshell.cc.

6305 {
6306  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6307  int n=pGetVariables((poly)u->Data(),e);
6308  jjINT_S_TO_ID(n,e,res);
6309  return FALSE;
6310 }

◆ 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:1705
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 3326 of file ipshell.cc.

3327 {
3328  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3329  if (res->data==NULL)
3330  res->data=(char *)new intvec(rVar(currRing));
3331  return FALSE;
3332 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3304 of file ipshell.cc.

3305 {
3306  ideal F=(ideal)id->Data();
3307  intvec * iv = new intvec(rVar(currRing));
3308  polyset s;
3309  int sl, n, i;
3310  int *x;
3311 
3312  res->data=(char *)iv;
3313  s = F->m;
3314  sl = IDELEMS(F) - 1;
3315  n = rVar(currRing);
3316  double wNsqr = (double)2.0 / (double)n;
3318  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3319  wCall(s, sl, x, wNsqr, currRing);
3320  for (i = n; i!=0; i--)
3321  (*iv)[i-1] = x[i + n + 1];
3322  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3323  return FALSE;
3324 }
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:610
#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:6327
#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 3471 of file ipshell.cc.

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

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4256 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5082 of file ipshell.cc.

5083 {
5084  int i,j;
5085  int count= self->roots[0]->getAnzRoots(); // number of roots
5086  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5087 
5088  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5089 
5090  if ( self->found_roots )
5091  {
5092  listofroots->Init( count );
5093 
5094  for (i=0; i < count; i++)
5095  {
5096  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5097  onepoint->Init(elem);
5098  for ( j= 0; j < elem; j++ )
5099  {
5100  if ( !rField_is_long_C(currRing) )
5101  {
5102  onepoint->m[j].rtyp=STRING_CMD;
5103  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5104  }
5105  else
5106  {
5107  onepoint->m[j].rtyp=NUMBER_CMD;
5108  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5109  }
5110  onepoint->m[j].next= NULL;
5111  onepoint->m[j].name= NULL;
5112  }
5113  listofroots->m[i].rtyp=LIST_CMD;
5114  listofroots->m[i].data=(void *)onepoint;
5115  listofroots->m[j].next= NULL;
5116  listofroots->m[j].name= NULL;
5117  }
5118 
5119  }
5120  else
5121  {
5122  listofroots->Init( 0 );
5123  }
5124 
5125  return listofroots;
5126 }
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 4566 of file ipshell.cc.

4567 {
4568  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4569  return FALSE;
4570 }
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 4572 of file ipshell.cc.

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

3075 {
3076  int i,j;
3077  matrix result;
3078  ideal id=(ideal)a->Data();
3079 
3080  result =mpNew(IDELEMS(id),rVar(currRing));
3081  for (i=1; i<=IDELEMS(id); i++)
3082  {
3083  for (j=1; j<=rVar(currRing); j++)
3084  {
3085  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3086  }
3087  }
3088  res->data=(char *)result;
3089  return FALSE;
3090 }
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 3096 of file ipshell.cc.

3097 {
3098  int n=(int)(long)b->Data();
3099  int d=(int)(long)c->Data();
3100  int k,l,sign,row,col;
3101  matrix result;
3102  ideal temp;
3103  BOOLEAN bo;
3104  poly p;
3105 
3106  if ((d>n) || (d<1) || (n<1))
3107  {
3108  res->data=(char *)mpNew(1,1);
3109  return FALSE;
3110  }
3111  int *choise = (int*)omAlloc(d*sizeof(int));
3112  if (id==NULL)
3113  temp=idMaxIdeal(1);
3114  else
3115  temp=(ideal)id->Data();
3116 
3117  k = binom(n,d);
3118  l = k*d;
3119  l /= n-d+1;
3120  result =mpNew(l,k);
3121  col = 1;
3122  idInitChoise(d,1,n,&bo,choise);
3123  while (!bo)
3124  {
3125  sign = 1;
3126  for (l=1;l<=d;l++)
3127  {
3128  if (choise[l-1]<=IDELEMS(temp))
3129  {
3130  p = pCopy(temp->m[choise[l-1]-1]);
3131  if (sign == -1) p = pNeg(p);
3132  sign *= -1;
3133  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3134  MATELEM(result,row,col) = p;
3135  }
3136  }
3137  col++;
3138  idGetNextChoise(d,n,&bo,choise);
3139  }
3140  omFreeSize(choise,d*sizeof(int));
3141  if (id==NULL) idDelete(&temp);
3142 
3143  res->data=(char *)result;
3144  return FALSE;
3145 }
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:3372

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

4682 {
4683  poly gls;
4684  gls= (poly)(arg1->Data());
4685  int howclean= (int)(long)arg3->Data();
4686 
4687  if ( gls == NULL || pIsConstant( gls ) )
4688  {
4689  WerrorS("Input polynomial is constant!");
4690  return TRUE;
4691  }
4692 
4693  if (rField_is_Zp(currRing))
4694  {
4695  int* r=Zp_roots(gls, currRing);
4696  lists rlist;
4697  rlist= (lists)omAlloc( sizeof(slists) );
4698  rlist->Init( r[0] );
4699  for(int i=r[0];i>0;i--)
4700  {
4701  rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4702  rlist->m[i-1].rtyp=NUMBER_CMD;
4703  }
4704  omFree(r);
4705  res->data=rlist;
4706  res->rtyp= LIST_CMD;
4707  return FALSE;
4708  }
4709  if ( !(rField_is_R(currRing) ||
4710  rField_is_Q(currRing) ||
4713  {
4714  WerrorS("Ground field not implemented!");
4715  return TRUE;
4716  }
4717 
4720  {
4721  unsigned long int ii = (unsigned long int)arg2->Data();
4722  setGMPFloatDigits( ii, ii );
4723  }
4724 
4725  int ldummy;
4726  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4727  int i,vpos=0;
4728  poly piter;
4729  lists elist;
4730 
4731  elist= (lists)omAlloc( sizeof(slists) );
4732  elist->Init( 0 );
4733 
4734  if ( rVar(currRing) > 1 )
4735  {
4736  piter= gls;
4737  for ( i= 1; i <= rVar(currRing); i++ )
4738  if ( pGetExp( piter, i ) )
4739  {
4740  vpos= i;
4741  break;
4742  }
4743  while ( piter )
4744  {
4745  for ( i= 1; i <= rVar(currRing); i++ )
4746  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4747  {
4748  WerrorS("The input polynomial must be univariate!");
4749  return TRUE;
4750  }
4751  pIter( piter );
4752  }
4753  }
4754 
4755  rootContainer * roots= new rootContainer();
4756  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4757  piter= gls;
4758  for ( i= deg; i >= 0; i-- )
4759  {
4760  if ( piter && pTotaldegree(piter) == i )
4761  {
4762  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4763  //nPrint( pcoeffs[i] );PrintS(" ");
4764  pIter( piter );
4765  }
4766  else
4767  {
4768  pcoeffs[i]= nInit(0);
4769  }
4770  }
4771 
4772 #ifdef mprDEBUG_PROT
4773  for (i=deg; i >= 0; i--)
4774  {
4775  nPrint( pcoeffs[i] );PrintS(" ");
4776  }
4777  PrintLn();
4778 #endif
4779 
4780  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4781  roots->solver( howclean );
4782 
4783  int elem= roots->getAnzRoots();
4784  char *dummy;
4785  int j;
4786 
4787  lists rlist;
4788  rlist= (lists)omAlloc( sizeof(slists) );
4789  rlist->Init( elem );
4790 
4792  {
4793  for ( j= 0; j < elem; j++ )
4794  {
4795  rlist->m[j].rtyp=NUMBER_CMD;
4796  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4797  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4798  }
4799  }
4800  else
4801  {
4802  for ( j= 0; j < elem; j++ )
4803  {
4804  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4805  rlist->m[j].rtyp=STRING_CMD;
4806  rlist->m[j].data=(void *)dummy;
4807  }
4808  }
4809 
4810  elist->Clean();
4811  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4812 
4813  // this is (via fillContainer) the same data as in root
4814  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4815  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4816 
4817  delete roots;
4818 
4819  res->data= (void*)rlist;
4820 
4821  return FALSE;
4822 }
int * Zp_roots(poly p, const ring r)
Definition: clapsing.cc:2059
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 4658 of file ipshell.cc.

4659 {
4660  ideal gls = (ideal)(arg1->Data());
4661  int imtype= (int)(long)arg2->Data();
4662 
4663  uResultant::resMatType mtype= determineMType( imtype );
4664 
4665  // check input ideal ( = polynomial system )
4666  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4667  {
4668  return TRUE;
4669  }
4670 
4671  uResultant *resMat= new uResultant( gls, mtype, false );
4672  if (resMat!=NULL)
4673  {
4674  res->rtyp = MODUL_CMD;
4675  res->data= (void*)resMat->accessResMat()->getMatrix();
4676  if (!errorreported) delete resMat;
4677  }
4678  return errorreported;
4679 }
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 4925 of file ipshell.cc.

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

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

6328 {
6329  Print(" %s (",n);
6330  switch (p->language)
6331  {
6332  case LANG_SINGULAR: PrintS("S"); break;
6333  case LANG_C: PrintS("C"); break;
6334  case LANG_TOP: PrintS("T"); break;
6335  case LANG_MAX: PrintS("M"); break;
6336  case LANG_NONE: PrintS("N"); break;
6337  default: PrintS("U");
6338  }
6339  if(p->libname!=NULL)
6340  Print(",%s", p->libname);
6341  PrintS(")");
6342 }
@ 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 2787 of file ipshell.cc.

2788 {
2789  if ((L->nr!=3)
2790 #ifdef HAVE_PLURAL
2791  &&(L->nr!=5)
2792 #endif
2793  )
2794  return NULL;
2795  int is_gf_char=0;
2796  // 0: char/ cf - ring
2797  // 1: list (var)
2798  // 2: list (ord)
2799  // 3: qideal
2800  // possibly:
2801  // 4: C
2802  // 5: D
2803 
2804  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2805 
2806  // ------------------------------------------------------------------
2807  // 0: char:
2808  if (L->m[0].Typ()==CRING_CMD)
2809  {
2810  R->cf=(coeffs)L->m[0].Data();
2811  R->cf->ref++;
2812  }
2813  else if (L->m[0].Typ()==INT_CMD)
2814  {
2815  int ch = (int)(long)L->m[0].Data();
2816  assume( ch >= 0 );
2817 
2818  if (ch == 0) // Q?
2819  R->cf = nInitChar(n_Q, NULL);
2820  else
2821  {
2822  int l = IsPrime(ch); // Zp?
2823  if( l != ch )
2824  {
2825  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2826  ch = l;
2827  }
2828  #ifndef TEST_ZN_AS_ZP
2829  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2830  #else
2831  mpz_t modBase;
2832  mpz_init_set_ui(modBase,(long) ch);
2833  ZnmInfo info;
2834  info.base= modBase;
2835  info.exp= 1;
2836  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2837  R->cf->is_field=1;
2838  R->cf->is_domain=1;
2839  R->cf->has_simple_Inverse=1;
2840  #endif
2841  }
2842  }
2843  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2844  {
2845  lists LL=(lists)L->m[0].Data();
2846 
2847 #ifdef HAVE_RINGS
2848  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2849  {
2850  rComposeRing(LL, R); // Ring!?
2851  }
2852  else
2853 #endif
2854  if (LL->nr < 3)
2855  rComposeC(LL,R); // R, long_R, long_C
2856  else
2857  {
2858  if (LL->m[0].Typ()==INT_CMD)
2859  {
2860  int ch = (int)(long)LL->m[0].Data();
2861  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2862  if (fftable[is_gf_char]==0) is_gf_char=-1;
2863 
2864  if(is_gf_char!= -1)
2865  {
2866  GFInfo param;
2867 
2868  param.GFChar = ch;
2869  param.GFDegree = 1;
2870  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2871 
2872  // nfInitChar should be able to handle the case when ch is in fftables!
2873  R->cf = nInitChar(n_GF, (void*)&param);
2874  }
2875  }
2876 
2877  if( R->cf == NULL )
2878  {
2879  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2880 
2881  if (extRing==NULL)
2882  {
2883  WerrorS("could not create the specified coefficient field");
2884  goto rCompose_err;
2885  }
2886 
2887  if( extRing->qideal != NULL ) // Algebraic extension
2888  {
2889  AlgExtInfo extParam;
2890 
2891  extParam.r = extRing;
2892 
2893  R->cf = nInitChar(n_algExt, (void*)&extParam);
2894  }
2895  else // Transcendental extension
2896  {
2897  TransExtInfo extParam;
2898  extParam.r = extRing;
2899  assume( extRing->qideal == NULL );
2900 
2901  R->cf = nInitChar(n_transExt, &extParam);
2902  }
2903  }
2904  }
2905  }
2906  else
2907  {
2908  WerrorS("coefficient field must be described by `int` or `list`");
2909  goto rCompose_err;
2910  }
2911 
2912  if( R->cf == NULL )
2913  {
2914  WerrorS("could not create coefficient field described by the input!");
2915  goto rCompose_err;
2916  }
2917 
2918  // ------------------------- VARS ---------------------------
2919  if (rComposeVar(L,R)) goto rCompose_err;
2920  // ------------------------ ORDER ------------------------------
2921  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2922 
2923  // ------------------------ ??????? --------------------
2924 
2925  if (!isLetterplace) rRenameVars(R);
2926  #ifdef HAVE_SHIFTBBA
2927  else
2928  {
2929  R->isLPring=isLetterplace;
2930  R->ShortOut=FALSE;
2931  R->CanShortOut=FALSE;
2932  }
2933  #endif
2934  if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2935  rComplete(R);
2936 
2937  // ------------------------ Q-IDEAL ------------------------
2938 
2939  if (L->m[3].Typ()==IDEAL_CMD)
2940  {
2941  ideal q=(ideal)L->m[3].Data();
2942  if (q->m[0]!=NULL)
2943  {
2944  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2945  {
2946  #if 0
2947  WerrorS("coefficient fields must be equal if q-ideal !=0");
2948  goto rCompose_err;
2949  #else
2950  ring orig_ring=currRing;
2951  rChangeCurrRing(R);
2952  int *perm=NULL;
2953  int *par_perm=NULL;
2954  int par_perm_size=0;
2955  nMapFunc nMap;
2956 
2957  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2958  {
2959  if (rEqual(orig_ring,currRing))
2960  {
2961  nMap=n_SetMap(currRing->cf, currRing->cf);
2962  }
2963  else
2964  // Allow imap/fetch to be make an exception only for:
2965  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2969  ||
2970  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2971  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2972  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2973  {
2974  par_perm_size=rPar(orig_ring);
2975 
2976 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2977 // naSetChar(rInternalChar(orig_ring),orig_ring);
2978 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2979 
2980  nSetChar(currRing->cf);
2981  }
2982  else
2983  {
2984  WerrorS("coefficient fields must be equal if q-ideal !=0");
2985  goto rCompose_err;
2986  }
2987  }
2988  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2989  if (par_perm_size!=0)
2990  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2991  int i;
2992  #if 0
2993  // use imap:
2994  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2995  currRing->names,currRing->N,currRing->parameter, currRing->P,
2996  perm,par_perm, currRing->ch);
2997  #else
2998  // use fetch
2999  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
3000  {
3001  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
3002  }
3003  else if (par_perm_size!=0)
3004  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3005  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3006  #endif
3007  ideal dest_id=idInit(IDELEMS(q),1);
3008  for(i=IDELEMS(q)-1; i>=0; i--)
3009  {
3010  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3011  par_perm,par_perm_size);
3012  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3013  pTest(dest_id->m[i]);
3014  }
3015  R->qideal=dest_id;
3016  if (perm!=NULL)
3017  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3018  if (par_perm!=NULL)
3019  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3020  rChangeCurrRing(orig_ring);
3021  #endif
3022  }
3023  else
3024  R->qideal=idrCopyR(q,currRing,R);
3025  }
3026  }
3027  else
3028  {
3029  WerrorS("q-ideal must be given as `ideal`");
3030  goto rCompose_err;
3031  }
3032 
3033 
3034  // ---------------------------------------------------------------
3035  #ifdef HAVE_PLURAL
3036  if (L->nr==5)
3037  {
3038  if (nc_CallPlural((matrix)L->m[4].Data(),
3039  (matrix)L->m[5].Data(),
3040  NULL,NULL,
3041  R,
3042  true, // !!!
3043  true, false,
3044  currRing, FALSE)) goto rCompose_err;
3045  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3046  }
3047  #endif
3048  return R;
3049 
3050 rCompose_err:
3051  if (R->N>0)
3052  {
3053  int i;
3054  if (R->names!=NULL)
3055  {
3056  i=R->N-1;
3057  while (i>=0) { omfree(R->names[i]); i--; }
3058  omFree(R->names);
3059  }
3060  }
3061  omfree(R->order);
3062  omfree(R->block0);
3063  omfree(R->block1);
3064  omfree(R->wvhdl);
3065  omFree(R);
3066  return NULL;
3067 }
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:354
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:2409
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2264
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2495
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2787
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2316
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2450
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:387
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:4163
#define pTest(p)
Definition: polys.h:415
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:191
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:3395
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:1660
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 2264 of file ipshell.cc.

2266 {
2267  // ----------------------------------------
2268  // 0: char/ cf - ring
2269  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2270  {
2271  WerrorS("invalid coeff. field description, expecting 0");
2272  return;
2273  }
2274 // R->cf->ch=0;
2275  // ----------------------------------------
2276  // 0, (r1,r2) [, "i" ]
2277  if (L->m[1].rtyp!=LIST_CMD)
2278  {
2279  WerrorS("invalid coeff. field description, expecting precision list");
2280  return;
2281  }
2282  lists LL=(lists)L->m[1].data;
2283  if ((LL->nr!=1)
2284  || (LL->m[0].rtyp!=INT_CMD)
2285  || (LL->m[1].rtyp!=INT_CMD))
2286  {
2287  WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2288  return;
2289  }
2290  int r1=(int)(long)LL->m[0].data;
2291  int r2=(int)(long)LL->m[1].data;
2292  r1=si_min(r1,32767);
2293  r2=si_min(r2,32767);
2294  LongComplexInfo par; memset(&par, 0, sizeof(par));
2295  par.float_len=r1;
2296  par.float_len2=r2;
2297  if (L->nr==2) // complex
2298  {
2299  if (L->m[2].rtyp!=STRING_CMD)
2300  {
2301  WerrorS("invalid coeff. field description, expecting parameter name");
2302  return;
2303  }
2304  par.par_name=(char*)L->m[2].data;
2305  R->cf = nInitChar(n_long_C, &par);
2306  }
2307  else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2308  R->cf = nInitChar(n_R, NULL);
2309  else /* && L->nr==1*/
2310  {
2311  R->cf = nInitChar(n_long_R, &par);
2312  }
2313 }
@ 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 2495 of file ipshell.cc.

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

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

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2165 of file ipshell.cc.

2166 {
2167  assume( r != NULL );
2168  const coeffs C = r->cf;
2169  assume( C != NULL );
2170 
2171  // sanity check: require currRing==r for rings with polynomial data
2172  if ( (r!=currRing) && (
2173  (nCoeff_is_algExt(C) && (C != currRing->cf))
2174  || (r->qideal != NULL)
2175 #ifdef HAVE_PLURAL
2176  || (rIsPluralRing(r))
2177 #endif
2178  )
2179  )
2180  {
2181  WerrorS("ring with polynomial data must be the base ring or compatible");
2182  return NULL;
2183  }
2184  // 0: char/ cf - ring
2185  // 1: list (var)
2186  // 2: list (ord)
2187  // 3: qideal
2188  // possibly:
2189  // 4: C
2190  // 5: D
2192  if (rIsPluralRing(r))
2193  L->Init(6);
2194  else
2195  L->Init(4);
2196  // ----------------------------------------
2197  // 0: char/ cf - ring
2198  if (rField_is_numeric(r))
2199  {
2200  rDecomposeC(&(L->m[0]),r);
2201  }
2202  else if (rField_is_Ring(r))
2203  {
2204  rDecomposeRing(&(L->m[0]),r);
2205  }
2206  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2207  {
2208  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2209  }
2210  else if(rField_is_GF(r))
2211  {
2213  Lc->Init(4);
2214  // char:
2215  Lc->m[0].rtyp=INT_CMD;
2216  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2217  // var:
2219  Lv->Init(1);
2220  Lv->m[0].rtyp=STRING_CMD;
2221  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2222  Lc->m[1].rtyp=LIST_CMD;
2223  Lc->m[1].data=(void*)Lv;
2224  // ord:
2226  Lo->Init(1);
2228  Loo->Init(2);
2229  Loo->m[0].rtyp=STRING_CMD;
2230  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2231 
2232  intvec *iv=new intvec(1); (*iv)[0]=1;
2233  Loo->m[1].rtyp=INTVEC_CMD;
2234  Loo->m[1].data=(void *)iv;
2235 
2236  Lo->m[0].rtyp=LIST_CMD;
2237  Lo->m[0].data=(void*)Loo;
2238 
2239  Lc->m[2].rtyp=LIST_CMD;
2240  Lc->m[2].data=(void*)Lo;
2241  // q-ideal:
2242  Lc->m[3].rtyp=IDEAL_CMD;
2243  Lc->m[3].data=(void *)idInit(1,1);
2244  // ----------------------
2245  L->m[0].rtyp=LIST_CMD;
2246  L->m[0].data=(void*)Lc;
2247  }
2248  else if (rField_is_Zp(r) || rField_is_Q(r))
2249  {
2250  L->m[0].rtyp=INT_CMD;
2251  L->m[0].data=(void *)(long)r->cf->ch;
2252  }
2253  else
2254  {
2255  L->m[0].rtyp=CRING_CMD;
2256  L->m[0].data=(void *)r->cf;
2257  r->cf->ref++;
2258  }
2259  // ----------------------------------------
2260  rDecompose_23456(r,L);
2261  return L;
2262 }
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:1857
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1733
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1921
static void rDecompose_23456(const ring r, lists L)
Definition: ipshell.cc:2025
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 2025 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1953 of file ipshell.cc.

1954 {
1955  assume( C != NULL );
1956 
1957  // sanity check: require currRing==r for rings with polynomial data
1958  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1959  {
1960  WerrorS("ring with polynomial data must be the base ring or compatible");
1961  return TRUE;
1962  }
1963  if (nCoeff_is_numeric(C))
1964  {
1965  rDecomposeC_41(res,C);
1966  }
1967 #ifdef HAVE_RINGS
1968  else if (nCoeff_is_Ring(C))
1969  {
1971  }
1972 #endif
1973  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1974  {
1975  rDecomposeCF(res, C->extRing, currRing);
1976  }
1977  else if(nCoeff_is_GF(C))
1978  {
1980  Lc->Init(4);
1981  // char:
1982  Lc->m[0].rtyp=INT_CMD;
1983  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1984  // var:
1986  Lv->Init(1);
1987  Lv->m[0].rtyp=STRING_CMD;
1988  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1989  Lc->m[1].rtyp=LIST_CMD;
1990  Lc->m[1].data=(void*)Lv;
1991  // ord:
1993  Lo->Init(1);
1995  Loo->Init(2);
1996  Loo->m[0].rtyp=STRING_CMD;
1997  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1998 
1999  intvec *iv=new intvec(1); (*iv)[0]=1;
2000  Loo->m[1].rtyp=INTVEC_CMD;
2001  Loo->m[1].data=(void *)iv;
2002 
2003  Lo->m[0].rtyp=LIST_CMD;
2004  Lo->m[0].data=(void*)Loo;
2005 
2006  Lc->m[2].rtyp=LIST_CMD;
2007  Lc->m[2].data=(void*)Lo;
2008  // q-ideal:
2009  Lc->m[3].rtyp=IDEAL_CMD;
2010  Lc->m[3].data=(void *)idInit(1,1);
2011  // ----------------------
2012  res->rtyp=LIST_CMD;
2013  res->data=(void*)Lc;
2014  }
2015  else
2016  {
2017  res->rtyp=INT_CMD;
2018  res->data=(void *)(long)C->ch;
2019  }
2020  // ----------------------------------------
2021  return FALSE;
2022 }
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:1823
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1893

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2126 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1857 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1823 of file ipshell.cc.

1825 {
1827  if (nCoeff_is_long_C(C)) L->Init(3);
1828  else L->Init(2);
1829  h->rtyp=LIST_CMD;
1830  h->data=(void *)L;
1831  // 0: char/ cf - ring
1832  // 1: list (var)
1833  // 2: list (ord)
1834  // ----------------------------------------
1835  // 0: char/ cf - ring
1836  L->m[0].rtyp=INT_CMD;
1837  L->m[0].data=(void *)0;
1838  // ----------------------------------------
1839  // 1:
1841  LL->Init(2);
1842  LL->m[0].rtyp=INT_CMD;
1843  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1844  LL->m[1].rtyp=INT_CMD;
1845  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1846  L->m[1].rtyp=LIST_CMD;
1847  L->m[1].data=(void *)LL;
1848  // ----------------------------------------
1849  // 2: list (par)
1850  if (nCoeff_is_long_C(C))
1851  {
1852  L->m[2].rtyp=STRING_CMD;
1853  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1854  }
1855  // ----------------------------------------
1856 }
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 1733 of file ipshell.cc.

1734 {
1736  L->Init(4);
1737  h->rtyp=LIST_CMD;
1738  h->data=(void *)L;
1739  // 0: char/ cf - ring
1740  // 1: list (var)
1741  // 2: list (ord)
1742  // 3: qideal
1743  // ----------------------------------------
1744  // 0: char/ cf - ring
1745  L->m[0].rtyp=INT_CMD;
1746  L->m[0].data=(void *)(long)r->cf->ch;
1747  // ----------------------------------------
1748  // 1: list (var)
1750  LL->Init(r->N);
1751  int i;
1752  for(i=0; i<r->N; i++)
1753  {
1754  LL->m[i].rtyp=STRING_CMD;
1755  LL->m[i].data=(void *)omStrDup(r->names[i]);
1756  }
1757  L->m[1].rtyp=LIST_CMD;
1758  L->m[1].data=(void *)LL;
1759  // ----------------------------------------
1760  // 2: list (ord)
1762  i=rBlocks(r)-1;
1763  LL->Init(i);
1764  i--;
1765  lists LLL;
1766  for(; i>=0; i--)
1767  {
1768  intvec *iv;
1769  int j;
1770  LL->m[i].rtyp=LIST_CMD;
1772  LLL->Init(2);
1773  LLL->m[0].rtyp=STRING_CMD;
1774  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1775  if (r->block1[i]-r->block0[i] >=0 )
1776  {
1777  j=r->block1[i]-r->block0[i];
1778  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1779  iv=new intvec(j+1);
1780  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1781  {
1782  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1783  }
1784  else switch (r->order[i])
1785  {
1786  case ringorder_dp:
1787  case ringorder_Dp:
1788  case ringorder_ds:
1789  case ringorder_Ds:
1790  case ringorder_lp:
1791  case ringorder_rp:
1792  case ringorder_ls:
1793  for(;j>=0; j--) (*iv)[j]=1;
1794  break;
1795  default: /* do nothing */;
1796  }
1797  }
1798  else
1799  {
1800  iv=new intvec(1);
1801  }
1802  LLL->m[1].rtyp=INTVEC_CMD;
1803  LLL->m[1].data=(void *)iv;
1804  LL->m[i].data=(void *)LLL;
1805  }
1806  L->m[2].rtyp=LIST_CMD;
1807  L->m[2].data=(void *)LL;
1808  // ----------------------------------------
1809  // 3: qideal
1810  L->m[3].rtyp=IDEAL_CMD;
1811  if (nCoeff_is_transExt(R->cf))
1812  L->m[3].data=(void *)idInit(1,1);
1813  else
1814  {
1815  ideal q=idInit(IDELEMS(r->qideal));
1816  q->m[0]=p_Init(R);
1817  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1818  L->m[3].data=(void *)q;
1819 // I->m[0] = pNSet(R->minpoly);
1820  }
1821  // ----------------------------------------
1822 }
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:1292

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1921 of file ipshell.cc.

1923 {
1924 #ifdef HAVE_RINGS
1926  if (rField_is_Z(R)) L->Init(1);
1927  else L->Init(2);
1928  h->rtyp=LIST_CMD;
1929  h->data=(void *)L;
1930  // 0: char/ cf - ring
1931  // 1: list (module)
1932  // ----------------------------------------
1933  // 0: char/ cf - ring
1934  L->m[0].rtyp=STRING_CMD;
1935  L->m[0].data=(void *)omStrDup("integer");
1936  // ----------------------------------------
1937  // 1: module
1938  if (rField_is_Z(R)) return;
1940  LL->Init(2);
1941  LL->m[0].rtyp=BIGINT_CMD;
1942  LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1943  LL->m[1].rtyp=INT_CMD;
1944  LL->m[1].data=(void *) R->cf->modExponent;
1945  L->m[1].rtyp=LIST_CMD;
1946  L->m[1].data=(void *)LL;
1947 #else
1948  WerrorS("rDecomposeRing");
1949 #endif
1950 }
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 1893 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1648 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1705 of file ipshell.cc.

1706 {
1707  if ((r==NULL)||(r->VarOffset==NULL))
1708  return NULL;
1710  if (h!=NULL) return h;
1711  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1712  if (h!=NULL) return h;
1714  while(p!=NULL)
1715  {
1716  if ((p->cPack!=basePack)
1717  && (p->cPack!=currPack))
1718  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1719  if (h!=NULL) return h;
1720  p=p->next;
1721  }
1722  idhdl tmp=basePack->idroot;
1723  while (tmp!=NULL)
1724  {
1725  if (IDTYP(tmp)==PACKAGE_CMD)
1726  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1727  if (h!=NULL) return h;
1728  tmp=IDNEXT(tmp);
1729  }
1730  return NULL;
1731 }
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:6263

◆ rInit()

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

Definition at line 5628 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6220 of file ipshell.cc.

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

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5189 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2409 of file ipshell.cc.

2410 {
2411  int i,j;
2412  BOOLEAN ch;
2413  do
2414  {
2415  ch=0;
2416  for(i=0;i<R->N-1;i++)
2417  {
2418  for(j=i+1;j<R->N;j++)
2419  {
2420  if (strcmp(R->names[i],R->names[j])==0)
2421  {
2422  ch=TRUE;
2423  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);
2424  omFree(R->names[j]);
2425  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2426  sprintf(R->names[j],"@%s",R->names[i]);
2427  }
2428  }
2429  }
2430  }
2431  while (ch);
2432  for(i=0;i<rPar(R); i++)
2433  {
2434  for(j=0;j<R->N;j++)
2435  {
2436  if (strcmp(rParameter(R)[i],R->names[j])==0)
2437  {
2438  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);
2439 // omFree(rParameter(R)[i]);
2440 // rParameter(R)[i]=(char *)omAlloc(10);
2441 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2442  omFree(R->names[j]);
2443  R->names[j]=(char *)omAlloc(10);
2444  sprintf(R->names[j],"@@(%d)",i+1);
2445  }
2446  }
2447  }
2448 }

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5129 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6263 of file ipshell.cc.

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

◆ rSleftvList2StringArray()

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

Definition at line 5580 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5308 of file ipshell.cc.

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

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

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

1104 {
1105  int i;
1106  indset save;
1108 
1109  hexist = hInit(S, Q, &hNexist, currRing);
1110  if (hNexist == 0)
1111  {
1112  intvec *iv=new intvec(rVar(currRing));
1113  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1114  res->Init(1);
1115  res->m[0].rtyp=INTVEC_CMD;
1116  res->m[0].data=(intvec*)iv;
1117  return res;
1118  }
1119  else if (hisModule!=0)
1120  {
1121  res->Init(0);
1122  return res;
1123  }
1124  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1125  hMu = 0;
1126  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1127  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1128  hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1129  hrad = hexist;
1130  hNrad = hNexist;
1131  radmem = hCreate(rVar(currRing) - 1);
1132  hCo = rVar(currRing) + 1;
1133  hNvar = rVar(currRing);
1134  hRadical(hrad, &hNrad, hNvar);
1135  hSupp(hrad, hNrad, hvar, &hNvar);
1136  if (hNvar)
1137  {
1138  hCo = hNvar;
1139  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1140  hLexR(hrad, hNrad, hvar, hNvar);
1142  }
1143  if (hCo && (hCo < rVar(currRing)))
1144  {
1146  }
1147  if (hMu!=0)
1148  {
1149  ISet = save;
1150  hMu2 = 0;
1151  if (all && (hCo+1 < rVar(currRing)))
1152  {
1155  i=hMu+hMu2;
1156  res->Init(i);
1157  if (hMu2 == 0)
1158  {
1160  }
1161  }
1162  else
1163  {
1164  res->Init(hMu);
1165  }
1166  for (i=0;i<hMu;i++)
1167  {
1168  res->m[i].data = (void *)save->set;
1169  res->m[i].rtyp = INTVEC_CMD;
1170  ISet = save;
1171  save = save->nx;
1173  }
1174  omFreeBin((ADDRESS)save, indlist_bin);
1175  if (hMu2 != 0)
1176  {
1177  save = JSet;
1178  for (i=hMu;i<hMu+hMu2;i++)
1179  {
1180  res->m[i].data = (void *)save->set;
1181  res->m[i].rtyp = INTVEC_CMD;
1182  JSet = save;
1183  save = save->nx;
1185  }
1186  omFreeBin((ADDRESS)save, indlist_bin);
1187  }
1188  }
1189  else
1190  {
1191  res->Init(0);
1193  }
1194  hKill(radmem, rVar(currRing) - 1);
1195  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1196  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1197  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1199  return res;
1200 }
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:386
VAR int hMu
Definition: hdegree.cc:27
VAR omBin indlist_bin
Definition: hdegree.cc:28
VAR int hMu2
Definition: hdegree.cc:27
VAR int hCo
Definition: hdegree.cc:27
VAR indset ISet
Definition: hdegree.cc:352
VAR indset JSet
Definition: hdegree.cc:352
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:34
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:569
monf hCreate(int Nvar)
Definition: hutil.cc:999
scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
Definition: hutil.cc:31
VAR varset hvar
Definition: hutil.cc:18
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1013
VAR int hNexist
Definition: hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:143
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:624
VAR scfmon hwork
Definition: hutil.cc:16
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:177
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:568
VAR scmon hpure
Definition: hutil.cc:17
VAR scfmon hrad
Definition: hutil.cc:16
VAR int hisModule
Definition: hutil.cc:20
VAR monf radmem
Definition: hutil.cc:21
VAR int hNpure
Definition: hutil.cc:19
VAR int hNrad
Definition: hutil.cc:19
VAR scfmon hexist
Definition: hutil.cc:16
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:414
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 4554 of file ipshell.cc.

4555 {
4556  sleftv tmp;
4557  tmp.Init();
4558  tmp.rtyp=INT_CMD;
4559  /* tmp.data = (void *)0; -- done by Init */
4560 
4561  return semicProc3(res,u,v,&tmp);
4562 }
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4514

◆ semicProc3()

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

Definition at line 4514 of file ipshell.cc.

4515 {
4516  semicState state;
4517  BOOLEAN qh=(((int)(long)w->Data())==1);
4518 
4519  // -----------------
4520  // check arguments
4521  // -----------------
4522 
4523  lists l1 = (lists)u->Data( );
4524  lists l2 = (lists)v->Data( );
4525 
4526  if( (state=list_is_spectrum( l1 ))!=semicOK )
4527  {
4528  WerrorS( "first argument is not a spectrum" );
4529  list_error( state );
4530  }
4531  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4532  {
4533  WerrorS( "second argument is not a spectrum" );
4534  list_error( state );
4535  }
4536  else
4537  {
4538  spectrum s1= spectrumFromList( l1 );
4539  spectrum s2= spectrumFromList( l2 );
4540 
4541  res->rtyp = INT_CMD;
4542  if (qh)
4543  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4544  else
4545  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4546  }
4547 
4548  // -----------------
4549  // check status
4550  // -----------------
4551 
4552  return (state!=semicOK);
4553 }
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:3471
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3387
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4256

◆ spaddProc()

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

Definition at line 4431 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3813 of file ipshell.cc.

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

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3387 of file ipshell.cc.

3388 {
3389  spectrum result;
3390  copy_deep( result, l );
3391  return result;
3392 }
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3363

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4105 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4136 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3572 of file ipshell.cc.

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

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3175 of file ipshell.cc.

3176 {
3177  sleftv tmp;
3178  tmp.Init();
3179  tmp.rtyp=INT_CMD;
3180  tmp.data=(void *)1;
3181  return syBetti2(res,u,&tmp);
3182 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3152

◆ syBetti2()

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

Definition at line 3152 of file ipshell.cc.

3153 {
3154  syStrategy syzstr=(syStrategy)u->Data();
3155 
3156  BOOLEAN minim=(int)(long)w->Data();
3157  int row_shift=0;
3158  int add_row_shift=0;
3159  intvec *weights=NULL;
3160  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3161  if (ww!=NULL)
3162  {
3163  weights=ivCopy(ww);
3164  add_row_shift = ww->min_in();
3165  (*weights) -= add_row_shift;
3166  }
3167 
3168  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3169  //row_shift += add_row_shift;
3170  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3171  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3172 
3173  return FALSE;
3174 }
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 3259 of file ipshell.cc.

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

◆ syConvRes()

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

Definition at line 3187 of file ipshell.cc.

3188 {
3189  resolvente fullres = syzstr->fullres;
3190  resolvente minres = syzstr->minres;
3191 
3192  const int length = syzstr->length;
3193 
3194  if ((fullres==NULL) && (minres==NULL))
3195  {
3196  if (syzstr->hilb_coeffs==NULL)
3197  { // La Scala
3198  fullres = syReorder(syzstr->res, length, syzstr);
3199  }
3200  else
3201  { // HRES
3202  minres = syReorder(syzstr->orderedRes, length, syzstr);
3203  syKillEmptyEntres(minres, length);
3204  }
3205  }
3206 
3207  resolvente tr;
3208  int typ0=IDEAL_CMD;
3209 
3210  if (minres!=NULL)
3211  tr = minres;
3212  else
3213  tr = fullres;
3214 
3215  resolvente trueres=NULL;
3216  intvec ** w=NULL;
3217 
3218  if (length>0)
3219  {
3220  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3221  for (int i=length-1;i>=0;i--)
3222  {
3223  if (tr[i]!=NULL)
3224  {
3225  trueres[i] = idCopy(tr[i]);
3226  }
3227  }
3228  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3229  typ0 = MODUL_CMD;
3230  if (syzstr->weights!=NULL)
3231  {
3232  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3233  for (int i=length-1;i>=0;i--)
3234  {
3235  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3236  }
3237  }
3238  }
3239 
3240  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3241  w, add_row_shift);
3242 
3243  if (toDel)
3244  syKillComputation(syzstr);
3245  else
3246  {
3247  if( fullres != NULL && syzstr->fullres == NULL )
3248  syzstr->fullres = fullres;
3249 
3250  if( minres != NULL && syzstr->minres == NULL )
3251  syzstr->minres = minres;
3252  }
3253  return li;
3254 }
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 3288 of file ipshell.cc.

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

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