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)
 
static 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)
 
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 3434 of file ipshell.cc.

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3550 of file ipshell.cc.

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

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3360 of file ipshell.cc.

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

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

6432 {
6433  res->Init();
6434  res->rtyp=a->Typ();
6435  switch (res->rtyp /*a->Typ()*/)
6436  {
6437  case INTVEC_CMD:
6438  case INTMAT_CMD:
6439  return iiApplyINTVEC(res,a,op,proc);
6440  case BIGINTMAT_CMD:
6441  return iiApplyBIGINTMAT(res,a,op,proc);
6442  case IDEAL_CMD:
6443  case MODUL_CMD:
6444  case MATRIX_CMD:
6445  return iiApplyIDEAL(res,a,op,proc);
6446  case LIST_CMD:
6447  return iiApplyLIST(res,a,op,proc);
6448  }
6449  WerrorS("first argument to `apply` must allow an index");
6450  return TRUE;
6451 }
#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:6350
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6392
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6387
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6382

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6382 of file ipshell.cc.

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

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6387 of file ipshell.cc.

6388 {
6389  WerrorS("not implemented");
6390  return TRUE;
6391 }

◆ iiApplyINTVEC()

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

Definition at line 6350 of file ipshell.cc.

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

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

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6514 of file ipshell.cc.

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

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1273 of file ipshell.cc.

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

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1630 of file ipshell.cc.

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

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1586 of file ipshell.cc.

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

◆ iiCheckTypes()

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

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

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

Definition at line 6572 of file ipshell.cc.

6573 {
6574  int l=0;
6575  if (args==NULL)
6576  {
6577  if (type_list[0]==0) return TRUE;
6578  }
6579  else l=args->listLength();
6580  if (l!=(int)type_list[0])
6581  {
6582  if (report) iiReportTypes(0,l,type_list);
6583  return FALSE;
6584  }
6585  for(int i=1;i<=l;i++,args=args->next)
6586  {
6587  short t=type_list[i];
6588  if (t!=ANY_TYPE)
6589  {
6590  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6591  || (t!=args->Typ()))
6592  {
6593  if (report) iiReportTypes(i,args->Typ(),type_list);
6594  return FALSE;
6595  }
6596  }
6597  }
6598  return TRUE;
6599 }
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6554
void report(const char *fmt, const char *name)
Definition: shared.cc:666
#define ANY_TYPE
Definition: tok.h:30

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 936 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1198 of file ipshell.cc.

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

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1260 of file ipshell.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1511 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1534 of file ipshell.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1606 of file ipshell.cc.

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

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1412 of file ipshell.cc.

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

◆ iiInternalExport() [2/2]

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

Definition at line 1465 of file ipshell.cc.

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

◆ 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:239
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define V_DEF_RES
Definition: options.h:50

◆ 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:697
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
const CanonicalForm & w
Definition: facAbsFact.cc:51
int j
Definition: facHensel.cc:110
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition: gen_maps.cc:87
@ MAP_CMD
Definition: grammar.cc:285
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
#define IDMAP(a)
Definition: ipid.h:135
#define IDIDEAL(a)
Definition: ipid.h:133
BOOLEAN maApplyFetch(int what, map theMap, leftv res, leftv w, ring preimage_r, int *perm, int *par_perm, int P, nMapFunc nMap)
Definition: maps_ip.cc:45
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
poly p_One(const ring r)
Definition: p_polys.cc:1313
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent @Note: VarOffset encodes the position in p->exp
Definition: p_polys.h:486
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:231
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:899
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:844
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1505
static long pTotaldegree(poly p)
Definition: polys.h:282
poly * polyset
Definition: polys.h:259
static BOOLEAN rIsLPRing(const ring r)
Definition: ring.h:411
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
#define IDELEMS(i)
Definition: simpleideals.h:23

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1376 of file ipshell.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

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

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

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

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

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 88 of file ipshell.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  v 
)

Definition at line 588 of file ipshell.cc.

589 {
590  sleftv vf;
591  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
592  {
593  WerrorS("link expected");
594  return TRUE;
595  }
596  si_link l=(si_link)vf.Data();
597  if (vf.next == NULL)
598  {
599  WerrorS("write: need at least two arguments");
600  return TRUE;
601  }
602 
603  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
604  if (b)
605  {
606  const char *s;
607  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
608  else s=sNoName_fe;
609  Werror("cannot write to %s",s);
610  }
611  vf.CleanUp();
612  return b;
613 }
const char sNoName_fe[]
Definition: fevoices.cc:57
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:435
@ LINK_CMD
Definition: tok.h:117

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 967 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3347 of file ipshell.cc.

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

◆ jjINT_S_TO_ID()

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

Definition at line 6288 of file ipshell.cc.

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

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

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

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6318 of file ipshell.cc.

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6310 of file ipshell.cc.

6311 {
6312  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6313  int n=pGetVariables((poly)u->Data(),e);
6314  jjINT_S_TO_ID(n,e,res);
6315  return FALSE;
6316 }

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

387 {
388  BOOLEAN changed=FALSE;
389  idhdl sh=currRingHdl;
390  ring cr=currRing;
391  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
392  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
393 
394  killlocals_rec(&(basePack->idroot),v,currRing);
395 
397  {
398  int t=iiRETURNEXPR.Typ();
399  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
400  {
402  if (((ring)h->data)->idroot!=NULL)
403  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
404  }
405  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
406  {
408  changed |=killlocals_list(v,(lists)h->data);
409  }
410  }
411  if (changed)
412  {
414  if (currRingHdl==NULL)
415  currRing=NULL;
416  else if(cr!=currRing)
417  rChangeCurrRing(cr);
418  }
419 
420  if (myynest<=1) iiNoKeepRing=TRUE;
421  //Print("end killlocals >= %d\n",v);
422  //listall();
423 }
VAR int iiRETURNEXPR_len
Definition: iplib.cc:475
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:366
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1701
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:330
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:295
void rChangeCurrRing(ring r)
Definition: polys.cc:15

◆ killlocals0()

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

Definition at line 295 of file ipshell.cc.

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

◆ killlocals_list()

BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 366 of file ipshell.cc.

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

◆ killlocals_rec()

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

Definition at line 330 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3323 of file ipshell.cc.

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

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3301 of file ipshell.cc.

3302 {
3303  ideal F=(ideal)id->Data();
3304  intvec * iv = new intvec(rVar(currRing));
3305  polyset s;
3306  int sl, n, i;
3307  int *x;
3308 
3309  res->data=(char *)iv;
3310  s = F->m;
3311  sl = IDELEMS(F) - 1;
3312  n = rVar(currRing);
3313  double wNsqr = (double)2.0 / (double)n;
3315  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3316  wCall(s, sl, x, wNsqr, currRing);
3317  for (i = n; i!=0; i--)
3318  (*iv)[i-1] = x[i + n + 1];
3319  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3320  return FALSE;
3321 }
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:960
CanonicalForm buf2
Definition: facFqBivar.cc:73
@ SMATRIX_CMD
Definition: grammar.cc:291
void ipListFlag(idhdl h)
Definition: ipid.cc:619
#define IDMATRIX(a)
Definition: ipid.h:134
#define IDSTRING(a)
Definition: ipid.h:136
#define IDINTVEC(a)
Definition: ipid.h:128
#define IDPOLY(a)
Definition: ipid.h:130
void paPrint(const char *n, package p)
Definition: ipshell.cc:6333
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27
static int pLength(poly a)
Definition: p_polys.h:188
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 3468 of file ipshell.cc.

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

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4253 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5079 of file ipshell.cc.

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

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

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4569 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3069 of file ipshell.cc.

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

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

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

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

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

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

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

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

6334 {
6335  Print(" %s (",n);
6336  switch (p->language)
6337  {
6338  case LANG_SINGULAR: PrintS("S"); break;
6339  case LANG_C: PrintS("C"); break;
6340  case LANG_TOP: PrintS("T"); break;
6341  case LANG_MAX: PrintS("M"); break;
6342  case LANG_NONE: PrintS("N"); break;
6343  default: PrintS("U");
6344  }
6345  if(p->libname!=NULL)
6346  Print(",%s", p->libname);
6347  PrintS(")");
6348 }
@ LANG_MAX
Definition: subexpr.h:22
@ LANG_SINGULAR
Definition: subexpr.h:22
@ LANG_TOP
Definition: subexpr.h:22

◆ rCompose()

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

Definition at line 2783 of file ipshell.cc.

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

◆ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2260 of file ipshell.cc.

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

◆ rComposeOrder()

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

Definition at line 2491 of file ipshell.cc.

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

◆ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2312 of file ipshell.cc.

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

◆ rComposeVar()

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

Definition at line 2446 of file ipshell.cc.

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2161 of file ipshell.cc.

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

◆ rDecompose_23456()

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

Definition at line 2021 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1949 of file ipshell.cc.

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2122 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1853 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1819 of file ipshell.cc.

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

◆ rDecomposeCF()

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

Definition at line 1729 of file ipshell.cc.

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

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1917 of file ipshell.cc.

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

◆ rDecomposeRing_41()

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

Definition at line 1889 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1644 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1701 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5625 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6226 of file ipshell.cc.

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

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5186 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2405 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5126 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6269 of file ipshell.cc.

6270 {
6271  idhdl h=root;
6272  while (h!=NULL)
6273  {
6274  if ((IDTYP(h)==RING_CMD)
6275  && (h!=n)
6276  && (IDRING(h)==r)
6277  )
6278  {
6279  return h;
6280  }
6281  h=IDNEXT(h);
6282  }
6283  return NULL;
6284 }

◆ rSleftvList2StringArray()

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

Definition at line 5577 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5305 of file ipshell.cc.

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

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

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4551 of file ipshell.cc.

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

◆ semicProc3()

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

Definition at line 4511 of file ipshell.cc.

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

◆ spaddProc()

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

Definition at line 4428 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3810 of file ipshell.cc.

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

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3384 of file ipshell.cc.

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

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4102 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4133 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3569 of file ipshell.cc.

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

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3170 of file ipshell.cc.

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

◆ syBetti2()

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

Definition at line 3147 of file ipshell.cc.

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

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

◆ syConvRes()

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

Definition at line 3182 of file ipshell.cc.

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

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