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/ring.h"
#include "polys/monomials/maps.h"
#include "polys/prCopy.h"
#include "polys/matpol.h"
#include "polys/weight.h"
#include "polys/clapsing.h"
#include "polys/ext_fields/algext.h"
#include "polys/ext_fields/transext.h"
#include "kernel/polys.h"
#include "kernel/ideals.h"
#include "kernel/numeric/mpr_base.h"
#include "kernel/numeric/mpr_numeric.h"
#include "kernel/GBEngine/syz.h"
#include "kernel/GBEngine/kstd1.h"
#include "kernel/GBEngine/kutil.h"
#include "kernel/combinatorics/stairc.h"
#include "kernel/combinatorics/hutil.h"
#include "kernel/spectrum/semic.h"
#include "kernel/spectrum/splist.h"
#include "kernel/spectrum/spectrum.h"
#include "kernel/oswrapper/feread.h"
#include "Singular/lists.h"
#include "Singular/attrib.h"
#include "Singular/ipconv.h"
#include "Singular/links/silink.h"
#include "Singular/ipshell.h"
#include "Singular/maps_ip.h"
#include "Singular/tok.h"
#include "Singular/ipid.h"
#include "Singular/subexpr.h"
#include "Singular/fevoices.h"
#include "Singular/sdb.h"
#include <cmath>
#include <ctype.h>
#include "kernel/maps/gen_maps.h"
#include "libparse.h"

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

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

Functions

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

Variables

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

Macro Definition Documentation

◆ BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH   80

Definition at line 989 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 3443 of file ipshell.cc.

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3559 of file ipshell.cc.

3560 {
3561  spectrumOK,
3562  spectrumZero,
3568  spectrumNoHC,
3570 };
@ spectrumWrongRing
Definition: ipshell.cc:3567
@ spectrumOK
Definition: ipshell.cc:3561
@ spectrumDegenerate
Definition: ipshell.cc:3566
@ spectrumUnspecErr
Definition: ipshell.cc:3569
@ spectrumNotIsolated
Definition: ipshell.cc:3565
@ spectrumBadPoly
Definition: ipshell.cc:3563
@ spectrumNoSingularity
Definition: ipshell.cc:3564
@ spectrumZero
Definition: ipshell.cc:3562
@ spectrumNoHC
Definition: ipshell.cc:3568

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3369 of file ipshell.cc.

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

551 {
552  int rc = 0;
553  while (v!=NULL)
554  {
555  switch (v->Typ())
556  {
557  case INT_CMD:
558  case POLY_CMD:
559  case VECTOR_CMD:
560  case NUMBER_CMD:
561  rc++;
562  break;
563  case INTVEC_CMD:
564  case INTMAT_CMD:
565  rc += ((intvec *)(v->Data()))->length();
566  break;
567  case MATRIX_CMD:
568  case IDEAL_CMD:
569  case MODUL_CMD:
570  {
571  matrix mm = (matrix)(v->Data());
572  rc += mm->rows() * mm->cols();
573  }
574  break;
575  case LIST_CMD:
576  rc+=((lists)v->Data())->nr+1;
577  break;
578  default:
579  rc++;
580  }
581  v = v->next;
582  }
583  return rc;
584 }
Variable next() const
Definition: factory.h:153
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 3405 of file ipshell.cc.

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

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

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6381 of file ipshell.cc.

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

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6386 of file ipshell.cc.

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

◆ iiApplyINTVEC()

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

Definition at line 6349 of file ipshell.cc.

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

◆ iiApplyLIST()

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

Definition at line 6391 of file ipshell.cc.

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

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

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

1203 {
1204  // must be inside a proc, as we simultae an proc_end at the end
1205  if (myynest==0)
1206  {
1207  WerrorS("branchTo can only occur in a proc");
1208  return TRUE;
1209  }
1210  // <string1...stringN>,<proc>
1211  // known: args!=NULL, l>=1
1212  int l=args->listLength();
1213  int ll=0;
1214  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1215  if (ll!=(l-1)) return FALSE;
1216  leftv h=args;
1217  // set up the table for type test:
1218  short *t=(short*)omAlloc(l*sizeof(short));
1219  t[0]=l-1;
1220  int b;
1221  int i;
1222  for(i=1;i<l;i++,h=h->next)
1223  {
1224  if (h->Typ()!=STRING_CMD)
1225  {
1226  omFree(t);
1227  Werror("arg %d is not a string",i);
1228  return TRUE;
1229  }
1230  int tt;
1231  b=IsCmd((char *)h->Data(),tt);
1232  if(b) t[i]=tt;
1233  else
1234  {
1235  omFree(t);
1236  Werror("arg %d is not a type name",i);
1237  return TRUE;
1238  }
1239  }
1240  if (h->Typ()!=PROC_CMD)
1241  {
1242  omFree(t);
1243  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1244  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1245  return TRUE;
1246  }
1247  b=iiCheckTypes(iiCurrArgs,t,0);
1248  omFree(t);
1249  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1250  {
1251  // get the proc:
1252  iiCurrProc=(idhdl)h->data;
1253  idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1254  procinfo * pi=IDPROC(currProc);
1255  // already loaded ?
1256  if( pi->data.s.body==NULL )
1257  {
1259  if (pi->data.s.body==NULL) return TRUE;
1260  }
1261  // set currPackHdl/currPack
1262  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1263  {
1264  currPack=pi->pack;
1267  //Print("set pack=%s\n",IDID(currPackHdl));
1268  }
1269  // see iiAllStart:
1270  BITSET save1=si_opt_1;
1271  BITSET save2=si_opt_2;
1272  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1273  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1274  BOOLEAN err=yyparse();
1275  iiCurrProc=NULL;
1276  si_opt_1=save1;
1277  si_opt_2=save2;
1278  // now save the return-expr.
1280  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1281  iiRETURNEXPR.Init();
1282  // warning about args.:
1283  if (iiCurrArgs!=NULL)
1284  {
1285  if (err==0) Warn("too many arguments for %s",IDID(currProc));
1286  iiCurrArgs->CleanUp();
1288  iiCurrArgs=NULL;
1289  }
1290  // similate proc_end:
1291  // - leave input
1292  void myychangebuffer();
1293  myychangebuffer();
1294  // - set the current buffer to its end (this is a pointer in a buffer,
1295  // not a file ptr) "branchTo" is only valid in proc)
1297  // - kill local vars
1299  // - return
1300  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1301  return (err!=0);
1302  }
1303  return FALSE;
1304 }
void * ADDRESS
Definition: auxiliary.h:119
char * buffer
Definition: fevoices.h:69
long fptr
Definition: fevoices.h:70
int listLength()
Definition: subexpr.cc:51
#define Warn
Definition: emacs.cc:77
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:164
VAR Voice * currentVoice
Definition: fevoices.cc:47
@ BT_execute
Definition: fevoices.h:23
@ BT_proc
Definition: fevoices.h:20
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
int yyparse(void)
Definition: grammar.cc:2111
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:9447
VAR package currPack
Definition: ipid.cc:57
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:823
#define IDPROC(a)
Definition: ipid.h:140
#define IDID(a)
Definition: ipid.h:122
INST_VAR sleftv iiRETURNEXPR
Definition: iplib.cc:470
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:193
VAR idhdl iiCurrProc
Definition: ipshell.cc:79
void iiCheckPack(package &p)
Definition: ipshell.cc:1561
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:6564
void killlocals(int v)
Definition: ipshell.cc:384
VAR leftv iiCurrArgs
Definition: ipshell.cc:78
#define pi
Definition: libparse.cc:1145
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
VAR unsigned si_opt_2
Definition: options.c:6
VAR unsigned si_opt_1
Definition: options.c:5
idrec * idhdl
Definition: ring.h:21
void myychangebuffer()
Definition: scanner.cc:2331
#define BITSET
Definition: structs.h:20
INST_VAR sleftv sLastPrinted
Definition: subexpr.cc:46
@ STRING_CMD
Definition: tok.h:185

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1561 of file ipshell.cc.

1562 {
1563  if (p!=basePack)
1564  {
1565  idhdl t=basePack->idroot;
1566  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1567  if (t==NULL)
1568  {
1569  WarnS("package not found\n");
1570  p=basePack;
1571  }
1572  }
1573 }
int p
Definition: cfModGcd.cc:4080
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 1517 of file ipshell.cc.

1518 {
1519  if (currRing==NULL)
1520  {
1521  #ifdef SIQ
1522  if (siq<=0)
1523  {
1524  #endif
1525  if (RingDependend(i))
1526  {
1527  WerrorS("no ring active (9)");
1528  return TRUE;
1529  }
1530  #ifdef SIQ
1531  }
1532  #endif
1533  }
1534  return FALSE;
1535 }
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 6564 of file ipshell.cc.

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

862 {
863  int i;
864  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
865 
866  for (i=0; i<l; i++)
867  if (r[i]!=NULL) res[i]=idCopy(r[i]);
868  return res;
869 }
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 990 of file ipshell.cc.

991 {
992 #ifdef HAVE_SDB
993  sdb_flags=1;
994 #endif
995  Print("\n-- break point in %s --\n",VoiceName());
997  char * s;
999  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1000  loop
1001  {
1002  memset(s,0,BREAK_LINE_LENGTH+4);
1004  if (s[BREAK_LINE_LENGTH-1]!='\0')
1005  {
1006  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1007  }
1008  else
1009  break;
1010  }
1011  if (*s=='\n')
1012  {
1014  }
1015 #if MDEBUG
1016  else if(strncmp(s,"cont;",5)==0)
1017  {
1019  }
1020 #endif /* MDEBUG */
1021  else
1022  {
1023  strcat( s, "\n;~\n");
1025  }
1026 }
#define Print
Definition: emacs.cc:80
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:34
const char * VoiceName()
Definition: fevoices.cc:56
void VoiceBackTrack()
Definition: fevoices.cc:75
VAR BOOLEAN iiDebugMarker
Definition: ipshell.cc:988
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:989
VAR int sdb_flags
Definition: sdb.cc:31
#define loop
Definition: structs.h:80

◆ iiDeclCommand()

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

Definition at line 1127 of file ipshell.cc.

1128 {
1129  BOOLEAN res=FALSE;
1130  BOOLEAN is_qring=FALSE;
1131  const char *id = name->name;
1132 
1133  sy->Init();
1134  if ((name->name==NULL)||(isdigit(name->name[0])))
1135  {
1136  WerrorS("object to declare is not a name");
1137  res=TRUE;
1138  }
1139  else
1140  {
1141  if (root==NULL) return TRUE;
1142  if (*root!=IDROOT)
1143  {
1144  if ((currRing==NULL) || (*root!=currRing->idroot))
1145  {
1146  Werror("can not define `%s` in other package",name->name);
1147  return TRUE;
1148  }
1149  }
1150  if (t==QRING_CMD)
1151  {
1152  t=RING_CMD; // qring is always RING_CMD
1153  is_qring=TRUE;
1154  }
1155 
1156  if (TEST_V_ALLWARN
1157  && (name->rtyp!=0)
1158  && (name->rtyp!=IDHDL)
1159  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1160  {
1161  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1163  }
1164  {
1165  sy->data = (char *)enterid(id,lev,t,root,init_b);
1166  }
1167  if (sy->data!=NULL)
1168  {
1169  sy->rtyp=IDHDL;
1170  currid=sy->name=IDID((idhdl)sy->data);
1171  if (is_qring)
1172  {
1174  }
1175  // name->name=NULL; /* used in enterid */
1176  //sy->e = NULL;
1177  if (name->next!=NULL)
1178  {
1180  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1181  }
1182  }
1183  else res=TRUE;
1184  }
1185  name->CleanUp();
1186  return res;
1187 }
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:278
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:141
#define Sy_bit(x)
Definition: options.h:31
@ QRING_CMD
Definition: tok.h:158

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1189 of file ipshell.cc.

1190 {
1191  attr at=NULL;
1192  if (iiCurrProc!=NULL)
1193  at=iiCurrProc->attribute->get("default_arg");
1194  if (at==NULL)
1195  return FALSE;
1196  sleftv tmp;
1197  tmp.Init();
1198  tmp.rtyp=at->atyp;
1199  tmp.data=at->CopyA();
1200  return iiAssign(p,&tmp);
1201 }
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 1439 of file ipshell.cc.

1440 {
1441  BOOLEAN nok=FALSE;
1442  leftv r=v;
1443  while (v!=NULL)
1444  {
1445  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1446  {
1447  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1448  nok=TRUE;
1449  }
1450  else
1451  {
1452  if(iiInternalExport(v, toLev))
1453  {
1454  r->CleanUp();
1455  return TRUE;
1456  }
1457  }
1458  v=v->next;
1459  }
1460  r->CleanUp();
1461  return nok;
1462 }
char name() const
Definition: variable.cc:122
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1341

◆ iiExport() [2/2]

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

Definition at line 1465 of file ipshell.cc.

1466 {
1467 // if ((pack==basePack)&&(pack!=currPack))
1468 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1469  BOOLEAN nok=FALSE;
1470  leftv rv=v;
1471  while (v!=NULL)
1472  {
1473  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1474  )
1475  {
1476  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1477  nok=TRUE;
1478  }
1479  else
1480  {
1481  idhdl old=pack->idroot->get( v->name,toLev);
1482  if (old!=NULL)
1483  {
1484  if ((pack==currPack) && (old==(idhdl)v->data))
1485  {
1486  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1487  break;
1488  }
1489  else if (IDTYP(old)==v->Typ())
1490  {
1491  if (BVERBOSE(V_REDEFINE))
1492  {
1493  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1494  }
1495  v->name=omStrDup(v->name);
1496  killhdl2(old,&(pack->idroot),currRing);
1497  }
1498  else
1499  {
1500  rv->CleanUp();
1501  return TRUE;
1502  }
1503  }
1504  //Print("iiExport: pack=%s\n",IDID(root));
1505  if(iiInternalExport(v, toLev, pack))
1506  {
1507  rv->CleanUp();
1508  return TRUE;
1509  }
1510  }
1511  v=v->next;
1512  }
1513  rv->CleanUp();
1514  return nok;
1515 }
idhdl get(const char *s, int lev)
Definition: ipid.cc:72
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:437
#define BVERBOSE(a)
Definition: options.h:34
#define V_REDEFINE
Definition: options.h:44

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1537 of file ipshell.cc.

1538 {
1539  int i;
1540  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1541  poly po=NULL;
1543  {
1544  scComputeHC(I,currRing->qideal,ak,po);
1545  if (po!=NULL)
1546  {
1547  pGetCoeff(po)=nInit(1);
1548  for (i=rVar(currRing); i>0; i--)
1549  {
1550  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1551  }
1552  pSetComp(po,ak);
1553  pSetm(po);
1554  }
1555  }
1556  else
1557  po=pOne();
1558  return po;
1559 }
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1078
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:597
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:765

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1341 of file ipshell.cc.

1342 {
1343  idhdl h=(idhdl)v->data;
1344  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1345  if (IDLEV(h)==0)
1346  {
1347  if ((myynest>0) && (BVERBOSE(V_REDEFINE))) Warn("`%s` is already global",IDID(h));
1348  }
1349  else
1350  {
1351  h=IDROOT->get(v->name,toLev);
1352  idhdl *root=&IDROOT;
1353  if ((h==NULL)&&(currRing!=NULL))
1354  {
1355  h=currRing->idroot->get(v->name,toLev);
1356  root=&currRing->idroot;
1357  }
1358  BOOLEAN keepring=FALSE;
1359  if ((h!=NULL)&&(IDLEV(h)==toLev))
1360  {
1361  if (IDTYP(h)==v->Typ())
1362  {
1363  if ((IDTYP(h)==RING_CMD)
1364  && (v->Data()==IDDATA(h)))
1365  {
1366  rIncRefCnt(IDRING(h));
1367  keepring=TRUE;
1368  IDLEV(h)=toLev;
1369  //WarnS("keepring");
1370  return FALSE;
1371  }
1372  if (BVERBOSE(V_REDEFINE))
1373  {
1374  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1375  }
1376  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1377  killhdl2(h,root,currRing);
1378  }
1379  else
1380  {
1381  return TRUE;
1382  }
1383  }
1384  h=(idhdl)v->data;
1385  IDLEV(h)=toLev;
1386  if (keepring) rDecRefCnt(IDRING(h));
1388  //Print("export %s\n",IDID(h));
1389  }
1390  return FALSE;
1391 }
#define IDDATA(a)
Definition: ipid.h:126
#define IDRING(a)
Definition: ipid.h:127
VAR ring * iiLocalRing
Definition: iplib.cc:469
STATIC_VAR BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
if(yy_init)
Definition: libparse.cc:1420
static ring rIncRefCnt(ring r)
Definition: ring.h:847
static void rDecRefCnt(ring r)
Definition: ring.h:848

◆ iiInternalExport() [2/2]

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

Definition at line 1393 of file ipshell.cc.

1394 {
1395  idhdl h=(idhdl)v->data;
1396  if(h==NULL)
1397  {
1398  Warn("'%s': no such identifier\n", v->name);
1399  return FALSE;
1400  }
1401  package frompack=v->req_packhdl;
1402  if (frompack==NULL) frompack=currPack;
1403  if ((RingDependend(IDTYP(h)))
1404  || ((IDTYP(h)==LIST_CMD)
1405  && (lRingDependend(IDLIST(h)))
1406  )
1407  )
1408  {
1409  //Print("// ==> Ringdependent set nesting to 0\n");
1410  return (iiInternalExport(v, toLev));
1411  }
1412  else
1413  {
1414  IDLEV(h)=toLev;
1415  v->req_packhdl=rootpack;
1416  if (h==frompack->idroot)
1417  {
1418  frompack->idroot=h->next;
1419  }
1420  else
1421  {
1422  idhdl hh=frompack->idroot;
1423  while ((hh!=NULL) && (hh->next!=h))
1424  hh=hh->next;
1425  if ((hh!=NULL) && (hh->next==h))
1426  hh->next=h->next;
1427  else
1428  {
1429  Werror("`%s` not found",v->Name());
1430  return TRUE;
1431  }
1432  }
1433  h->next=rootpack->idroot;
1434  rootpack->idroot=h;
1435  }
1436  return FALSE;
1437 }
#define IDLIST(a)
Definition: ipid.h:137
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199

◆ iiMakeResolv()

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

Definition at line 772 of file ipshell.cc.

774 {
775  lists L=liMakeResolv(r,length,rlen,typ0,weights);
776  int i=0;
777  idhdl h;
778  char * s=(char *)omAlloc(strlen(name)+5);
779 
780  while (i<=L->nr)
781  {
782  sprintf(s,"%s(%d)",name,i+1);
783  if (i==0)
784  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
785  else
786  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
787  if (h!=NULL)
788  {
789  h->data.uideal=(ideal)L->m[i].data;
790  h->attribute=L->m[i].attribute;
792  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
793  }
794  else
795  {
796  idDelete((ideal *)&(L->m[i].data));
797  Warn("cannot define %s",s);
798  }
799  //L->m[i].data=NULL;
800  //L->m[i].rtyp=0;
801  //L->m[i].attribute=NULL;
802  i++;
803  }
804  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
806  omFreeSize((ADDRESS)s,strlen(name)+5);
807 }
attr attribute
Definition: subexpr.h:89
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:257
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define V_DEF_RES
Definition: options.h:49

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 613 of file ipshell.cc.

614 {
615  idhdl w,r;
616  leftv v;
617  int i;
618  nMapFunc nMap;
619 
620  r=IDROOT->get(theMap->preimage,myynest);
621  if ((currPack!=basePack)
622  &&((r==NULL) || ((r->typ != RING_CMD) )))
623  r=basePack->idroot->get(theMap->preimage,myynest);
624  if ((r==NULL) && (currRingHdl!=NULL)
625  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
626  {
627  r=currRingHdl;
628  }
629  if ((r!=NULL) && (r->typ == RING_CMD))
630  {
631  ring src_ring=IDRING(r);
632  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
633  {
634  Werror("can not map from ground field of %s to current ground field",
635  theMap->preimage);
636  return NULL;
637  }
638  if (IDELEMS(theMap)<src_ring->N)
639  {
640  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
641  IDELEMS(theMap)*sizeof(poly),
642  (src_ring->N)*sizeof(poly));
643  for(i=IDELEMS(theMap);i<src_ring->N;i++)
644  theMap->m[i]=NULL;
645  IDELEMS(theMap)=src_ring->N;
646  }
647  if (what==NULL)
648  {
649  WerrorS("argument of a map must have a name");
650  }
651  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
652  {
653  char *save_r=NULL;
655  sleftv tmpW;
656  tmpW.Init();
657  tmpW.rtyp=IDTYP(w);
658  if (tmpW.rtyp==MAP_CMD)
659  {
660  tmpW.rtyp=IDEAL_CMD;
661  save_r=IDMAP(w)->preimage;
662  IDMAP(w)->preimage=0;
663  }
664  tmpW.data=IDDATA(w);
665  // check overflow
666  BOOLEAN overflow=FALSE;
667  if ((tmpW.rtyp==IDEAL_CMD)
668  || (tmpW.rtyp==MODUL_CMD)
669  || (tmpW.rtyp==MAP_CMD))
670  {
671  ideal id=(ideal)tmpW.data;
672  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
673  for(int i=IDELEMS(id)-1;i>=0;i--)
674  {
675  poly p=id->m[i];
676  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
677  else degs[i]=0;
678  }
679  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
680  {
681  if (theMap->m[j]!=NULL)
682  {
683  long deg_monexp=pTotaldegree(theMap->m[j]);
684 
685  for(int i=IDELEMS(id)-1;i>=0;i--)
686  {
687  poly p=id->m[i];
688  if ((p!=NULL) && (degs[i]!=0) &&
689  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
690  {
691  overflow=TRUE;
692  break;
693  }
694  }
695  }
696  }
697  omFreeSize(degs,IDELEMS(id)*sizeof(long));
698  }
699  else if (tmpW.rtyp==POLY_CMD)
700  {
701  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
702  {
703  if (theMap->m[j]!=NULL)
704  {
705  long deg_monexp=pTotaldegree(theMap->m[j]);
706  poly p=(poly)tmpW.data;
707  long deg=0;
708  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
709  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
710  {
711  overflow=TRUE;
712  break;
713  }
714  }
715  }
716  }
717  if (overflow)
718  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
719 #if 0
720  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
721  {
722  v->rtyp=tmpW.rtyp;
723  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
724  }
725  else
726 #endif
727  {
728  if ((tmpW.rtyp==IDEAL_CMD)
729  ||(tmpW.rtyp==MODUL_CMD)
730  ||(tmpW.rtyp==MATRIX_CMD)
731  ||(tmpW.rtyp==MAP_CMD))
732  {
733  v->rtyp=tmpW.rtyp;
734  char *tmp = theMap->preimage;
735  theMap->preimage=(char*)1L;
736  // map gets 1 as its rank (as an ideal)
737  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
738  theMap->preimage=tmp; // map gets its preimage back
739  }
740  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
741  {
742  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
743  {
744  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
746  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
747  return NULL;
748  }
749  }
750  }
751  if (save_r!=NULL)
752  {
753  IDMAP(w)->preimage=save_r;
754  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
755  v->rtyp=MAP_CMD;
756  }
757  return v;
758  }
759  else
760  {
761  Werror("%s undefined in %s",what,theMap->preimage);
762  }
763  }
764  else
765  {
766  Werror("cannot find preimage %s",theMap->preimage);
767  }
768  return NULL;
769 }
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:723
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:74
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
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1467
static long pTotaldegree(poly p)
Definition: polys.h:282
poly * polyset
Definition: polys.h:259
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 119 of file ipshell.cc.

120 {
121 /* not handling: &&, ||, ** */
122  if (s[1]=='\0') return s[0];
123  else if (s[2]!='\0') return 0;
124  switch(s[0])
125  {
126  case '.': if (s[1]=='.') return DOTDOT;
127  else return 0;
128  case ':': if (s[1]==':') return COLONCOLON;
129  else return 0;
130  case '-': if (s[1]=='-') return MINUSMINUS;
131  else return 0;
132  case '+': if (s[1]=='+') return PLUSPLUS;
133  else return 0;
134  case '=': if (s[1]=='=') return EQUAL_EQUAL;
135  else return 0;
136  case '<': if (s[1]=='=') return LE;
137  else if (s[1]=='>') return NOTEQUAL;
138  else return 0;
139  case '>': if (s[1]=='=') return GE;
140  else return 0;
141  case '!': if (s[1]=='=') return NOTEQUAL;
142  else return 0;
143  }
144  return 0;
145 }
@ 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 1305 of file ipshell.cc.

1306 {
1307  if (iiCurrArgs==NULL)
1308  {
1309  if (strcmp(p->name,"#")==0)
1310  return iiDefaultParameter(p);
1311  Werror("not enough arguments for proc %s",VoiceName());
1312  p->CleanUp();
1313  return TRUE;
1314  }
1315  leftv h=iiCurrArgs;
1316  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1317  BOOLEAN is_default_list=FALSE;
1318  if (strcmp(p->name,"#")==0)
1319  {
1320  is_default_list=TRUE;
1321  rest=NULL;
1322  }
1323  else
1324  {
1325  h->next=NULL;
1326  }
1327  BOOLEAN res=iiAssign(p,h);
1328  if (is_default_list)
1329  {
1330  iiCurrArgs=NULL;
1331  }
1332  else
1333  {
1334  iiCurrArgs=rest;
1335  }
1336  h->CleanUp();
1338  return res;
1339 }
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1189

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 962 of file ipshell.cc.

963 {
964  int len,reg,typ0;
965 
966  resolvente r=liFindRes(L,&len,&typ0);
967 
968  if (r==NULL)
969  return -2;
970  intvec *weights=NULL;
971  int add_row_shift=0;
972  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
973  if (ww!=NULL)
974  {
975  weights=ivCopy(ww);
976  add_row_shift = ww->min_in();
977  (*weights) -= add_row_shift;
978  }
979  //Print("attr:%x\n",weights);
980 
981  intvec *dummy=syBetti(r,len,&reg,weights);
982  if (weights!=NULL) delete weights;
983  delete dummy;
984  omFreeSize((ADDRESS)r,len*sizeof(ideal));
985  return reg+1+add_row_shift;
986 }
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:132
int min_in()
Definition: intvec.h:121
intvec * ivCopy(const intvec *o)
Definition: intvec.h:135
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:770

◆ iiReportTypes()

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

Definition at line 6546 of file ipshell.cc.

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

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

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

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 86 of file ipshell.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  v 
)

Definition at line 586 of file ipshell.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 892 of file ipshell.cc.

893 {
894  sleftv tmp;
895  tmp.Init();
896  tmp.rtyp=INT_CMD;
897  tmp.data=(void *)1;
898  if ((u->Typ()==IDEAL_CMD)
899  || (u->Typ()==MODUL_CMD))
900  return jjBETTI2_ID(res,u,&tmp);
901  else
902  return jjBETTI2(res,u,&tmp);
903 }
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:905
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:926

◆ jjBETTI2()

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

Definition at line 926 of file ipshell.cc.

927 {
928  resolvente r;
929  int len;
930  int reg,typ0;
931  lists l=(lists)u->Data();
932 
933  intvec *weights=NULL;
934  int add_row_shift=0;
935  intvec *ww=NULL;
936  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
937  if (ww!=NULL)
938  {
939  weights=ivCopy(ww);
940  add_row_shift = ww->min_in();
941  (*weights) -= add_row_shift;
942  }
943  //Print("attr:%x\n",weights);
944 
945  r=liFindRes(l,&len,&typ0);
946  if (r==NULL) return TRUE;
947  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
948  res->data=(void*)res_im;
949  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
950  //Print("rowShift: %d ",add_row_shift);
951  for(int i=1;i<=res_im->rows();i++)
952  {
953  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
954  else break;
955  }
956  //Print(" %d\n",add_row_shift);
957  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
958  if (weights!=NULL) delete weights;
959  return FALSE;
960 }
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 905 of file ipshell.cc.

906 {
908  l->Init(1);
909  l->m[0].rtyp=u->Typ();
910  l->m[0].data=u->Data();
911  attr *a=u->Attribute();
912  if (a!=NULL)
913  l->m[0].attribute=*a;
914  sleftv tmp2;
915  tmp2.Init();
916  tmp2.rtyp=LIST_CMD;
917  tmp2.data=(void *)l;
918  BOOLEAN r=jjBETTI2(res,&tmp2,v);
919  l->m[0].data=NULL;
920  l->m[0].attribute=NULL;
921  l->m[0].rtyp=DEF_CMD;
922  l->Clean();
923  return r;
924 }
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 3356 of file ipshell.cc.

3357 {
3358  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3359  return (res->data==NULL);
3360 }
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1537

◆ jjINT_S_TO_ID()

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

Definition at line 6287 of file ipshell.cc.

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

872 {
873  int len=0;
874  int typ0;
875  lists L=(lists)v->Data();
876  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
877  int add_row_shift = 0;
878  if (weights==NULL)
879  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
880  if (weights!=NULL) add_row_shift=weights->min_in();
881  resolvente rr=liFindRes(L,&len,&typ0);
882  if (rr==NULL) return TRUE;
883  resolvente r=iiCopyRes(rr,len);
884 
885  syMinimizeResolvente(r,len,0);
886  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
887  len++;
888  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
889  return FALSE;
890 }
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:861
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:355

◆ jjPROC()

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

Definition at line 1607 of file iparith.cc.

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

◆ jjRESULTANT()

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

Definition at line 3349 of file ipshell.cc.

3350 {
3351  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3352  (poly)w->CopyD(), currRing);
3353  return errorreported;
3354 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:311
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 6317 of file ipshell.cc.

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6309 of file ipshell.cc.

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

◆ killlocals()

void killlocals ( int  v)

Definition at line 384 of file ipshell.cc.

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

◆ killlocals0()

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

Definition at line 293 of file ipshell.cc.

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

◆ killlocals_list()

BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 364 of file ipshell.cc.

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

◆ killlocals_rec()

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

Definition at line 328 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3332 of file ipshell.cc.

3333 {
3334  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3335  if (res->data==NULL)
3336  res->data=(char *)new intvec(rVar(currRing));
3337  return FALSE;
3338 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3310 of file ipshell.cc.

3311 {
3312  ideal F=(ideal)id->Data();
3313  intvec * iv = new intvec(rVar(currRing));
3314  polyset s;
3315  int sl, n, i;
3316  int *x;
3317 
3318  res->data=(char *)iv;
3319  s = F->m;
3320  sl = IDELEMS(F) - 1;
3321  n = rVar(currRing);
3322  double wNsqr = (double)2.0 / (double)n;
3324  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3325  wCall(s, sl, x, wNsqr, currRing);
3326  for (i = n; i!=0; i--)
3327  (*iv)[i-1] = x[i + n + 1];
3328  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3329  return FALSE;
3330 }
Variable x
Definition: cfModGcd.cc:4084
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.c:78

◆ list1()

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

Definition at line 147 of file ipshell.cc.

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

◆ list_cmd()

void list_cmd ( int  typ,
const char *  what,
const char *  prefix,
BOOLEAN  iterate,
BOOLEAN  fullname 
)

Definition at line 423 of file ipshell.cc.

424 {
425  package savePack=currPack;
426  idhdl h,start;
427  BOOLEAN all = typ<0;
428  BOOLEAN really_all=FALSE;
429 
430  if ( typ==0 )
431  {
432  if (strcmp(what,"all")==0)
433  {
434  if (currPack!=basePack)
435  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
436  really_all=TRUE;
437  h=basePack->idroot;
438  }
439  else
440  {
441  h = ggetid(what);
442  if (h!=NULL)
443  {
444  if (iterate) list1(prefix,h,TRUE,fullname);
445  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
446  if ((IDTYP(h)==RING_CMD)
447  //|| (IDTYP(h)==PACKAGE_CMD)
448  )
449  {
450  h=IDRING(h)->idroot;
451  }
452  else if(IDTYP(h)==PACKAGE_CMD)
453  {
455  //Print("list_cmd:package\n");
456  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
457  h=IDPACKAGE(h)->idroot;
458  }
459  else
460  {
461  currPack=savePack;
462  return;
463  }
464  }
465  else
466  {
467  Werror("%s is undefined",what);
468  currPack=savePack;
469  return;
470  }
471  }
472  all=TRUE;
473  }
474  else if (RingDependend(typ))
475  {
476  h = currRing->idroot;
477  }
478  else
479  h = IDROOT;
480  start=h;
481  while (h!=NULL)
482  {
483  if ((all
484  && (IDTYP(h)!=PROC_CMD)
485  &&(IDTYP(h)!=PACKAGE_CMD)
486  &&(IDTYP(h)!=CRING_CMD)
487  )
488  || (typ == IDTYP(h))
489  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
490  )
491  {
492  list1(prefix,h,start==currRingHdl, fullname);
493  if ((IDTYP(h)==RING_CMD)
494  && (really_all || (all && (h==currRingHdl)))
495  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
496  {
497  list_cmd(0,IDID(h),"// ",FALSE);
498  }
499  if (IDTYP(h)==PACKAGE_CMD && really_all)
500  {
501  package save_p=currPack;
503  list_cmd(0,IDID(h),"// ",FALSE);
504  currPack=save_p;
505  }
506  }
507  h = IDNEXT(h);
508  }
509  currPack=savePack;
510 }
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:423
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:147

◆ list_error()

void list_error ( semicState  state)

Definition at line 3477 of file ipshell.cc.

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

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4262 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5088 of file ipshell.cc.

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

4573 {
4574  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4575  return FALSE;
4576 }
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4578 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3080 of file ipshell.cc.

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

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

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

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

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

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

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

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

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

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

2272 {
2273  // ----------------------------------------
2274  // 0: char/ cf - ring
2275  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2276  {
2277  WerrorS("invalid coeff. field description, expecting 0");
2278  return;
2279  }
2280 // R->cf->ch=0;
2281  // ----------------------------------------
2282  // 0, (r1,r2) [, "i" ]
2283  if (L->m[1].rtyp!=LIST_CMD)
2284  {
2285  WerrorS("invalid coeff. field description, expecting precision list");
2286  return;
2287  }
2288  lists LL=(lists)L->m[1].data;
2289  if ((LL->nr!=1)
2290  || (LL->m[0].rtyp!=INT_CMD)
2291  || (LL->m[1].rtyp!=INT_CMD))
2292  {
2293  WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2294  return;
2295  }
2296  int r1=(int)(long)LL->m[0].data;
2297  int r2=(int)(long)LL->m[1].data;
2298  r1=si_min(r1,32767);
2299  r2=si_min(r2,32767);
2300  LongComplexInfo par; memset(&par, 0, sizeof(par));
2301  par.float_len=r1;
2302  par.float_len2=r2;
2303  if (L->nr==2) // complex
2304  {
2305  if (L->m[2].rtyp!=STRING_CMD)
2306  {
2307  WerrorS("invalid coeff. field description, expecting parameter name");
2308  return;
2309  }
2310  par.par_name=(char*)L->m[2].data;
2311  R->cf = nInitChar(n_long_C, &par);
2312  }
2313  else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2314  R->cf = nInitChar(n_R, NULL);
2315  else /* && L->nr==1*/
2316  {
2317  R->cf = nInitChar(n_long_R, &par);
2318  }
2319 }
@ n_R
single prescision (6,6) real numbers
Definition: coeffs.h:32
@ n_long_R
real floating point (GMP) numbers
Definition: coeffs.h:34
@ n_long_C
complex floating point (GMP) numbers
Definition: coeffs.h:42
short float_len2
additional char-flags, rInit
Definition: coeffs.h:103
const char * par_name
parameter name
Definition: coeffs.h:104
short float_len
additional char-flags, rInit
Definition: coeffs.h:102
#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 2501 of file ipshell.cc.

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

◆ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2322 of file ipshell.cc.

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

◆ rComposeVar()

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

Definition at line 2456 of file ipshell.cc.

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2082 of file ipshell.cc.

2083 {
2084  assume( r != NULL );
2085  const coeffs C = r->cf;
2086  assume( C != NULL );
2087 
2088  // sanity check: require currRing==r for rings with polynomial data
2089  if ( (r!=currRing) && (
2090  (nCoeff_is_algExt(C) && (C != currRing->cf))
2091  || (r->qideal != NULL)
2092 #ifdef HAVE_PLURAL
2093  || (rIsPluralRing(r))
2094 #endif
2095  )
2096  )
2097  {
2098  WerrorS("ring with polynomial data must be the base ring or compatible");
2099  return NULL;
2100  }
2101  // 0: char/ cf - ring
2102  // 1: list (var)
2103  // 2: list (ord)
2104  // 3: qideal
2105  // possibly:
2106  // 4: C
2107  // 5: D
2109  if (rIsPluralRing(r))
2110  L->Init(6);
2111  else
2112  L->Init(4);
2113  // ----------------------------------------
2114  // 0: char/ cf - ring
2115  if (rField_is_numeric(r))
2116  {
2117  rDecomposeC(&(L->m[0]),r);
2118  }
2119  else if (rField_is_Ring(r))
2120  {
2121  rDecomposeRing(&(L->m[0]),r);
2122  }
2123  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2124  {
2125  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2126  }
2127  else if(rField_is_GF(r))
2128  {
2130  Lc->Init(4);
2131  // char:
2132  Lc->m[0].rtyp=INT_CMD;
2133  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2134  // var:
2136  Lv->Init(1);
2137  Lv->m[0].rtyp=STRING_CMD;
2138  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2139  Lc->m[1].rtyp=LIST_CMD;
2140  Lc->m[1].data=(void*)Lv;
2141  // ord:
2143  Lo->Init(1);
2145  Loo->Init(2);
2146  Loo->m[0].rtyp=STRING_CMD;
2147  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2148 
2149  intvec *iv=new intvec(1); (*iv)[0]=1;
2150  Loo->m[1].rtyp=INTVEC_CMD;
2151  Loo->m[1].data=(void *)iv;
2152 
2153  Lo->m[0].rtyp=LIST_CMD;
2154  Lo->m[0].data=(void*)Loo;
2155 
2156  Lc->m[2].rtyp=LIST_CMD;
2157  Lc->m[2].data=(void*)Lo;
2158  // q-ideal:
2159  Lc->m[3].rtyp=IDEAL_CMD;
2160  Lc->m[3].data=(void *)idInit(1,1);
2161  // ----------------------
2162  L->m[0].rtyp=LIST_CMD;
2163  L->m[0].data=(void*)Lc;
2164  }
2165  else
2166  {
2167  L->m[0].rtyp=INT_CMD;
2168  L->m[0].data=(void *)(long)r->cf->ch;
2169  }
2170  // ----------------------------------------
2171  // 1: list (var)
2173  LL->Init(r->N);
2174  int i;
2175  for(i=0; i<r->N; i++)
2176  {
2177  LL->m[i].rtyp=STRING_CMD;
2178  LL->m[i].data=(void *)omStrDup(r->names[i]);
2179  }
2180  L->m[1].rtyp=LIST_CMD;
2181  L->m[1].data=(void *)LL;
2182  // ----------------------------------------
2183  // 2: list (ord)
2185  i=rBlocks(r)-1;
2186  LL->Init(i);
2187  i--;
2188  lists LLL;
2189  for(; i>=0; i--)
2190  {
2191  intvec *iv;
2192  int j;
2193  LL->m[i].rtyp=LIST_CMD;
2195  LLL->Init(2);
2196  LLL->m[0].rtyp=STRING_CMD;
2197  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2198 
2199  if((r->order[i] == ringorder_IS)
2200  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2201  {
2202  assume( r->block0[i] == r->block1[i] );
2203  const int s = r->block0[i];
2204  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2205 
2206  iv=new intvec(1);
2207  (*iv)[0] = s;
2208  }
2209  else if (r->block1[i]-r->block0[i] >=0 )
2210  {
2211  int bl=j=r->block1[i]-r->block0[i];
2212  if (r->order[i]==ringorder_M)
2213  {
2214  j=(j+1)*(j+1)-1;
2215  bl=j+1;
2216  }
2217  else if (r->order[i]==ringorder_am)
2218  {
2219  j+=r->wvhdl[i][bl+1];
2220  }
2221  iv=new intvec(j+1);
2222  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2223  {
2224  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2225  }
2226  else switch (r->order[i])
2227  {
2228  case ringorder_dp:
2229  case ringorder_Dp:
2230  case ringorder_ds:
2231  case ringorder_Ds:
2232  case ringorder_lp:
2233  case ringorder_ls:
2234  case ringorder_rp:
2235  for(;j>=0; j--) (*iv)[j]=1;
2236  break;
2237  default: /* do nothing */;
2238  }
2239  }
2240  else
2241  {
2242  iv=new intvec(1);
2243  }
2244  LLL->m[1].rtyp=INTVEC_CMD;
2245  LLL->m[1].data=(void *)iv;
2246  LL->m[i].data=(void *)LLL;
2247  }
2248  L->m[2].rtyp=LIST_CMD;
2249  L->m[2].data=(void *)LL;
2250  // ----------------------------------------
2251  // 3: qideal
2252  L->m[3].rtyp=IDEAL_CMD;
2253  if (r->qideal==NULL)
2254  L->m[3].data=(void *)idInit(1,1);
2255  else
2256  L->m[3].data=(void *)idCopy(r->qideal);
2257  // ----------------------------------------
2258 #ifdef HAVE_PLURAL // NC! in rDecompose
2259  if (rIsPluralRing(r))
2260  {
2261  L->m[4].rtyp=MATRIX_CMD;
2262  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2263  L->m[5].rtyp=MATRIX_CMD;
2264  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2265  }
2266 #endif
2267  return L;
2268 }
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:934
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1784
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1660
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1848
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:489
static int rBlocks(ring r)
Definition: ring.h:573
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:630
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:520
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:526

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1880 of file ipshell.cc.

1881 {
1882  assume( C != NULL );
1883 
1884  // sanity check: require currRing==r for rings with polynomial data
1885  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1886  {
1887  WerrorS("ring with polynomial data must be the base ring or compatible");
1888  return TRUE;
1889  }
1890  if (nCoeff_is_numeric(C))
1891  {
1892  rDecomposeC_41(res,C);
1893  }
1894 #ifdef HAVE_RINGS
1895  else if (nCoeff_is_Ring(C))
1896  {
1898  }
1899 #endif
1900  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1901  {
1902  rDecomposeCF(res, C->extRing, currRing);
1903  }
1904  else if(nCoeff_is_GF(C))
1905  {
1907  Lc->Init(4);
1908  // char:
1909  Lc->m[0].rtyp=INT_CMD;
1910  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1911  // var:
1913  Lv->Init(1);
1914  Lv->m[0].rtyp=STRING_CMD;
1915  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1916  Lc->m[1].rtyp=LIST_CMD;
1917  Lc->m[1].data=(void*)Lv;
1918  // ord:
1920  Lo->Init(1);
1922  Loo->Init(2);
1923  Loo->m[0].rtyp=STRING_CMD;
1924  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1925 
1926  intvec *iv=new intvec(1); (*iv)[0]=1;
1927  Loo->m[1].rtyp=INTVEC_CMD;
1928  Loo->m[1].data=(void *)iv;
1929 
1930  Lo->m[0].rtyp=LIST_CMD;
1931  Lo->m[0].data=(void*)Loo;
1932 
1933  Lc->m[2].rtyp=LIST_CMD;
1934  Lc->m[2].data=(void*)Lo;
1935  // q-ideal:
1936  Lc->m[3].rtyp=IDEAL_CMD;
1937  Lc->m[3].data=(void *)idInit(1,1);
1938  // ----------------------
1939  res->rtyp=LIST_CMD;
1940  res->data=(void*)Lc;
1941  }
1942  else
1943  {
1944  res->rtyp=INT_CMD;
1945  res->data=(void *)(long)C->ch;
1946  }
1947  // ----------------------------------------
1948  return FALSE;
1949 }
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:863
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:856
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:802
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:754
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1750
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1820

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 1951 of file ipshell.cc.

1952 {
1953  assume( r != NULL );
1954  const coeffs C = r->cf;
1955  assume( C != NULL );
1956 
1957  // sanity check: require currRing==r for rings with polynomial data
1958  if ( (r!=currRing) && (
1959  (r->qideal != NULL)
1960 #ifdef HAVE_PLURAL
1961  || (rIsPluralRing(r))
1962 #endif
1963  )
1964  )
1965  {
1966  WerrorS("ring with polynomial data must be the base ring or compatible");
1967  return NULL;
1968  }
1969  // 0: char/ cf - ring
1970  // 1: list (var)
1971  // 2: list (ord)
1972  // 3: qideal
1973  // possibly:
1974  // 4: C
1975  // 5: D
1977  if (rIsPluralRing(r))
1978  L->Init(6);
1979  else
1980  L->Init(4);
1981  // ----------------------------------------
1982  // 0: char/ cf - ring
1983  L->m[0].rtyp=CRING_CMD;
1984  L->m[0].data=(char*)r->cf; r->cf->ref++;
1985  // ----------------------------------------
1986  // 1: list (var)
1988  LL->Init(r->N);
1989  int i;
1990  for(i=0; i<r->N; i++)
1991  {
1992  LL->m[i].rtyp=STRING_CMD;
1993  LL->m[i].data=(void *)omStrDup(r->names[i]);
1994  }
1995  L->m[1].rtyp=LIST_CMD;
1996  L->m[1].data=(void *)LL;
1997  // ----------------------------------------
1998  // 2: list (ord)
2000  i=rBlocks(r)-1;
2001  LL->Init(i);
2002  i--;
2003  lists LLL;
2004  for(; i>=0; i--)
2005  {
2006  intvec *iv;
2007  int j;
2008  LL->m[i].rtyp=LIST_CMD;
2010  LLL->Init(2);
2011  LLL->m[0].rtyp=STRING_CMD;
2012  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2013 
2014  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2015  {
2016  assume( r->block0[i] == r->block1[i] );
2017  const int s = r->block0[i];
2018  assume( -2 < s && s < 2);
2019 
2020  iv=new intvec(1);
2021  (*iv)[0] = s;
2022  }
2023  else if (r->block1[i]-r->block0[i] >=0 )
2024  {
2025  int bl=j=r->block1[i]-r->block0[i];
2026  if (r->order[i]==ringorder_M)
2027  {
2028  j=(j+1)*(j+1)-1;
2029  bl=j+1;
2030  }
2031  else if (r->order[i]==ringorder_am)
2032  {
2033  j+=r->wvhdl[i][bl+1];
2034  }
2035  iv=new intvec(j+1);
2036  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2037  {
2038  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2039  }
2040  else switch (r->order[i])
2041  {
2042  case ringorder_dp:
2043  case ringorder_Dp:
2044  case ringorder_ds:
2045  case ringorder_Ds:
2046  case ringorder_lp:
2047  for(;j>=0; j--) (*iv)[j]=1;
2048  break;
2049  default: /* do nothing */;
2050  }
2051  }
2052  else
2053  {
2054  iv=new intvec(1);
2055  }
2056  LLL->m[1].rtyp=INTVEC_CMD;
2057  LLL->m[1].data=(void *)iv;
2058  LL->m[i].data=(void *)LLL;
2059  }
2060  L->m[2].rtyp=LIST_CMD;
2061  L->m[2].data=(void *)LL;
2062  // ----------------------------------------
2063  // 3: qideal
2064  L->m[3].rtyp=IDEAL_CMD;
2065  if (r->qideal==NULL)
2066  L->m[3].data=(void *)idInit(1,1);
2067  else
2068  L->m[3].data=(void *)idCopy(r->qideal);
2069  // ----------------------------------------
2070 #ifdef HAVE_PLURAL // NC! in rDecompose
2071  if (rIsPluralRing(r))
2072  {
2073  L->m[4].rtyp=MATRIX_CMD;
2074  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2075  L->m[5].rtyp=MATRIX_CMD;
2076  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2077  }
2078 #endif
2079  return L;
2080 }

◆ rDecomposeC()

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

Definition at line 1784 of file ipshell.cc.

1786 {
1788  if (rField_is_long_C(R)) L->Init(3);
1789  else L->Init(2);
1790  h->rtyp=LIST_CMD;
1791  h->data=(void *)L;
1792  // 0: char/ cf - ring
1793  // 1: list (var)
1794  // 2: list (ord)
1795  // ----------------------------------------
1796  // 0: char/ cf - ring
1797  L->m[0].rtyp=INT_CMD;
1798  L->m[0].data=(void *)0;
1799  // ----------------------------------------
1800  // 1:
1802  LL->Init(2);
1803  LL->m[0].rtyp=INT_CMD;
1804  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1805  LL->m[1].rtyp=INT_CMD;
1806  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1807  L->m[1].rtyp=LIST_CMD;
1808  L->m[1].data=(void *)LL;
1809  // ----------------------------------------
1810  // 2: list (par)
1811  if (rField_is_long_C(R))
1812  {
1813  L->m[2].rtyp=STRING_CMD;
1814  L->m[2].data=(void *)omStrDup(*rParameter(R));
1815  }
1816  // ----------------------------------------
1817 }

◆ rDecomposeC_41()

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

Definition at line 1750 of file ipshell.cc.

1752 {
1754  if (nCoeff_is_long_C(C)) L->Init(3);
1755  else L->Init(2);
1756  h->rtyp=LIST_CMD;
1757  h->data=(void *)L;
1758  // 0: char/ cf - ring
1759  // 1: list (var)
1760  // 2: list (ord)
1761  // ----------------------------------------
1762  // 0: char/ cf - ring
1763  L->m[0].rtyp=INT_CMD;
1764  L->m[0].data=(void *)0;
1765  // ----------------------------------------
1766  // 1:
1768  LL->Init(2);
1769  LL->m[0].rtyp=INT_CMD;
1770  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1771  LL->m[1].rtyp=INT_CMD;
1772  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1773  L->m[1].rtyp=LIST_CMD;
1774  L->m[1].data=(void *)LL;
1775  // ----------------------------------------
1776  // 2: list (par)
1777  if (nCoeff_is_long_C(C))
1778  {
1779  L->m[2].rtyp=STRING_CMD;
1780  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1781  }
1782  // ----------------------------------------
1783 }
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:918

◆ rDecomposeCF()

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

Definition at line 1660 of file ipshell.cc.

1661 {
1663  L->Init(4);
1664  h->rtyp=LIST_CMD;
1665  h->data=(void *)L;
1666  // 0: char/ cf - ring
1667  // 1: list (var)
1668  // 2: list (ord)
1669  // 3: qideal
1670  // ----------------------------------------
1671  // 0: char/ cf - ring
1672  L->m[0].rtyp=INT_CMD;
1673  L->m[0].data=(void *)(long)r->cf->ch;
1674  // ----------------------------------------
1675  // 1: list (var)
1677  LL->Init(r->N);
1678  int i;
1679  for(i=0; i<r->N; i++)
1680  {
1681  LL->m[i].rtyp=STRING_CMD;
1682  LL->m[i].data=(void *)omStrDup(r->names[i]);
1683  }
1684  L->m[1].rtyp=LIST_CMD;
1685  L->m[1].data=(void *)LL;
1686  // ----------------------------------------
1687  // 2: list (ord)
1689  i=rBlocks(r)-1;
1690  LL->Init(i);
1691  i--;
1692  lists LLL;
1693  for(; i>=0; i--)
1694  {
1695  intvec *iv;
1696  int j;
1697  LL->m[i].rtyp=LIST_CMD;
1699  LLL->Init(2);
1700  LLL->m[0].rtyp=STRING_CMD;
1701  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1702  if (r->block1[i]-r->block0[i] >=0 )
1703  {
1704  j=r->block1[i]-r->block0[i];
1705  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1706  iv=new intvec(j+1);
1707  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1708  {
1709  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1710  }
1711  else switch (r->order[i])
1712  {
1713  case ringorder_dp:
1714  case ringorder_Dp:
1715  case ringorder_ds:
1716  case ringorder_Ds:
1717  case ringorder_lp:
1718  case ringorder_rp:
1719  case ringorder_ls:
1720  for(;j>=0; j--) (*iv)[j]=1;
1721  break;
1722  default: /* do nothing */;
1723  }
1724  }
1725  else
1726  {
1727  iv=new intvec(1);
1728  }
1729  LLL->m[1].rtyp=INTVEC_CMD;
1730  LLL->m[1].data=(void *)iv;
1731  LL->m[i].data=(void *)LLL;
1732  }
1733  L->m[2].rtyp=LIST_CMD;
1734  L->m[2].data=(void *)LL;
1735  // ----------------------------------------
1736  // 3: qideal
1737  L->m[3].rtyp=IDEAL_CMD;
1738  if (nCoeff_is_transExt(R->cf))
1739  L->m[3].data=(void *)idInit(1,1);
1740  else
1741  {
1742  ideal q=idInit(IDELEMS(r->qideal));
1743  q->m[0]=p_Init(R);
1744  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1745  L->m[3].data=(void *)q;
1746 // I->m[0] = pNSet(R->minpoly);
1747  }
1748  // ----------------------------------------
1749 }
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:942
#define pSetCoeff0(p, n)
Definition: monomials.h:59
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1280

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1848 of file ipshell.cc.

1850 {
1851 #ifdef HAVE_RINGS
1853  if (rField_is_Z(R)) L->Init(1);
1854  else L->Init(2);
1855  h->rtyp=LIST_CMD;
1856  h->data=(void *)L;
1857  // 0: char/ cf - ring
1858  // 1: list (module)
1859  // ----------------------------------------
1860  // 0: char/ cf - ring
1861  L->m[0].rtyp=STRING_CMD;
1862  L->m[0].data=(void *)omStrDup("integer");
1863  // ----------------------------------------
1864  // 1: module
1865  if (rField_is_Z(R)) return;
1867  LL->Init(2);
1868  LL->m[0].rtyp=BIGINT_CMD;
1869  LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1870  LL->m[1].rtyp=INT_CMD;
1871  LL->m[1].data=(void *) R->cf->modExponent;
1872  L->m[1].rtyp=LIST_CMD;
1873  L->m[1].data=(void *)LL;
1874 #else
1875  WerrorS("rDecomposeRing");
1876 #endif
1877 }
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:543
static BOOLEAN rField_is_Z(const ring r)
Definition: ring.h:514

◆ rDecomposeRing_41()

void rDecomposeRing_41 ( leftv  h,
const coeffs  C 
)

Definition at line 1820 of file ipshell.cc.

1822 {
1824  if (nCoeff_is_Ring(C)) L->Init(1);
1825  else L->Init(2);
1826  h->rtyp=LIST_CMD;
1827  h->data=(void *)L;
1828  // 0: char/ cf - ring
1829  // 1: list (module)
1830  // ----------------------------------------
1831  // 0: char/ cf - ring
1832  L->m[0].rtyp=STRING_CMD;
1833  L->m[0].data=(void *)omStrDup("integer");
1834  // ----------------------------------------
1835  // 1: modulo
1836  if (nCoeff_is_Z(C)) return;
1838  LL->Init(2);
1839  LL->m[0].rtyp=BIGINT_CMD;
1840  LL->m[0].data=n_InitMPZ( C->modBase, coeffs_BIGINT);
1841  LL->m[1].rtyp=INT_CMD;
1842  LL->m[1].data=(void *) C->modExponent;
1843  L->m[1].rtyp=LIST_CMD;
1844  L->m[1].data=(void *)LL;
1845 }
static FORCE_INLINE BOOLEAN nCoeff_is_Z(const coeffs r)
Definition: coeffs.h:840

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1575 of file ipshell.cc.

1576 {
1577  idhdl tmp=NULL;
1578 
1579  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1580  if (tmp==NULL) return NULL;
1581 
1582 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1584  {
1586  }
1587 
1588  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1589 
1590  #ifndef TEST_ZN_AS_ZP
1591  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1592  #else
1593  mpz_t modBase;
1594  mpz_init_set_ui(modBase, (long)32003);
1595  ZnmInfo info;
1596  info.base= modBase;
1597  info.exp= 1;
1598  r->cf=nInitChar(n_Zn,(void*) &info);
1599  r->cf->is_field=1;
1600  r->cf->is_domain=1;
1601  r->cf->has_simple_Inverse=1;
1602  #endif
1603  r->N = 3;
1604  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1605  /*names*/
1606  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1607  r->names[0] = omStrDup("x");
1608  r->names[1] = omStrDup("y");
1609  r->names[2] = omStrDup("z");
1610  /*weights: entries for 3 blocks: NULL*/
1611  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1612  /*order: dp,C,0*/
1613  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1614  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1615  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1616  /* ringorder dp for the first block: var 1..3 */
1617  r->order[0] = ringorder_dp;
1618  r->block0[0] = 1;
1619  r->block1[0] = 3;
1620  /* ringorder C for the second block: no vars */
1621  r->order[1] = ringorder_C;
1622  /* the last block: everything is 0 */
1623  r->order[2] = (rRingOrder_t)0;
1624 
1625  /* complete ring intializations */
1626  rComplete(r);
1627  rSetHdl(tmp);
1628  return currRingHdl;
1629 }
BOOLEAN RingDependend()
Definition: subexpr.cc:418

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1632 of file ipshell.cc.

1633 {
1634  if ((r==NULL)||(r->VarOffset==NULL))
1635  return NULL;
1637  if (h!=NULL) return h;
1638  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1639  if (h!=NULL) return h;
1641  while(p!=NULL)
1642  {
1643  if ((p->cPack!=basePack)
1644  && (p->cPack!=currPack))
1645  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1646  if (h!=NULL) return h;
1647  p=p->next;
1648  }
1649  idhdl tmp=basePack->idroot;
1650  while (tmp!=NULL)
1651  {
1652  if (IDTYP(tmp)==PACKAGE_CMD)
1653  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1654  if (h!=NULL) return h;
1655  tmp=IDNEXT(tmp);
1656  }
1657  return NULL;
1658 }
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:6268

◆ rInit()

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

Definition at line 5634 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6225 of file ipshell.cc.

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

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6179 of file ipshell.cc.

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5195 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2415 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5135 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6268 of file ipshell.cc.

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

◆ rSleftvList2StringArray()

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

Definition at line 5586 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5314 of file ipshell.cc.

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

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

◆ scIndIndset()

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

Definition at line 1028 of file ipshell.cc.

1029 {
1030  int i;
1031  indset save;
1033 
1034  hexist = hInit(S, Q, &hNexist, currRing);
1035  if (hNexist == 0)
1036  {
1037  intvec *iv=new intvec(rVar(currRing));
1038  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1039  res->Init(1);
1040  res->m[0].rtyp=INTVEC_CMD;
1041  res->m[0].data=(intvec*)iv;
1042  return res;
1043  }
1044  else if (hisModule!=0)
1045  {
1046  res->Init(0);
1047  return res;
1048  }
1049  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1050  hMu = 0;
1051  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1052  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1053  hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1054  hrad = hexist;
1055  hNrad = hNexist;
1056  radmem = hCreate(rVar(currRing) - 1);
1057  hCo = rVar(currRing) + 1;
1058  hNvar = rVar(currRing);
1059  hRadical(hrad, &hNrad, hNvar);
1060  hSupp(hrad, hNrad, hvar, &hNvar);
1061  if (hNvar)
1062  {
1063  hCo = hNvar;
1064  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1065  hLexR(hrad, hNrad, hvar, hNvar);
1067  }
1068  if (hCo && (hCo < rVar(currRing)))
1069  {
1071  }
1072  if (hMu!=0)
1073  {
1074  ISet = save;
1075  hMu2 = 0;
1076  if (all && (hCo+1 < rVar(currRing)))
1077  {
1080  i=hMu+hMu2;
1081  res->Init(i);
1082  if (hMu2 == 0)
1083  {
1085  }
1086  }
1087  else
1088  {
1089  res->Init(hMu);
1090  }
1091  for (i=0;i<hMu;i++)
1092  {
1093  res->m[i].data = (void *)save->set;
1094  res->m[i].rtyp = INTVEC_CMD;
1095  ISet = save;
1096  save = save->nx;
1098  }
1099  omFreeBin((ADDRESS)save, indlist_bin);
1100  if (hMu2 != 0)
1101  {
1102  save = JSet;
1103  for (i=hMu;i<hMu+hMu2;i++)
1104  {
1105  res->m[i].data = (void *)save->set;
1106  res->m[i].rtyp = INTVEC_CMD;
1107  JSet = save;
1108  save = save->nx;
1110  }
1111  omFreeBin((ADDRESS)save, indlist_bin);
1112  }
1113  }
1114  else
1115  {
1116  res->Init(0);
1118  }
1119  hKill(radmem, rVar(currRing) - 1);
1120  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1121  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1122  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1124  return res;
1125 }
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:386
VAR int hMu
Definition: hdegree.cc:27
VAR omBin indlist_bin
Definition: hdegree.cc:28
VAR int hMu2
Definition: hdegree.cc:27
VAR int hCo
Definition: hdegree.cc:27
VAR indset ISet
Definition: hdegree.cc:352
VAR indset JSet
Definition: hdegree.cc:352
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:34
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:569
monf hCreate(int Nvar)
Definition: hutil.cc:999
scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
Definition: hutil.cc:31
VAR varset hvar
Definition: hutil.cc:18
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1013
VAR int hNexist
Definition: hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:143
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:624
VAR scfmon hwork
Definition: hutil.cc:16
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:177
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:568
VAR scmon hpure
Definition: hutil.cc:17
VAR scfmon hrad
Definition: hutil.cc:16
VAR int hisModule
Definition: hutil.cc:20
VAR monf radmem
Definition: hutil.cc:21
VAR int hNpure
Definition: hutil.cc:19
VAR int hNrad
Definition: hutil.cc:19
VAR scfmon hexist
Definition: hutil.cc:16
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:414
VAR int hNvar
Definition: hutil.cc:19
scmon * scfmon
Definition: hutil.h:15
indlist * indset
Definition: hutil.h:28
int * varset
Definition: hutil.h:16
int * scmon
Definition: hutil.h:14
STATIC_VAR jList * Q
Definition: janet.cc:30

◆ semicProc()

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

Definition at line 4560 of file ipshell.cc.

4561 {
4562  sleftv tmp;
4563  tmp.Init();
4564  tmp.rtyp=INT_CMD;
4565  /* tmp.data = (void *)0; -- done by Init */
4566 
4567  return semicProc3(res,u,v,&tmp);
4568 }
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4520

◆ semicProc3()

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

Definition at line 4520 of file ipshell.cc.

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

◆ spaddProc()

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

Definition at line 4437 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3819 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4193 of file ipshell.cc.

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3393 of file ipshell.cc.

3394 {
3395  spectrum result;
3396  copy_deep( result, l );
3397  return result;
3398 }
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3369

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4111 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4142 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3578 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4479 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3181 of file ipshell.cc.

3182 {
3183  sleftv tmp;
3184  tmp.Init();
3185  tmp.rtyp=INT_CMD;
3186  tmp.data=(void *)1;
3187  return syBetti2(res,u,&tmp);
3188 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3158

◆ syBetti2()

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

Definition at line 3158 of file ipshell.cc.

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

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

◆ syConvRes()

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

Definition at line 3193 of file ipshell.cc.

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

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3294 of file ipshell.cc.

3295 {
3296  int typ0;
3298 
3299  resolvente fr = liFindRes(li,&(result->length),&typ0);
3300  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3301  for (int i=result->length-1;i>=0;i--)
3302  {
3303  if (fr[i]!=NULL)
3304  result->minres[i] = idCopy(fr[i]);
3305  }
3306  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3307  return result;
3308 }

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 512 of file ipshell.cc.

513 {
514  int ii;
515 
516  if (i<0)
517  {
518  ii= -i;
519  if (ii < 32)
520  {
521  si_opt_1 &= ~Sy_bit(ii);
522  }
523  else if (ii < 64)
524  {
525  si_opt_2 &= ~Sy_bit(ii-32);
526  }
527  else
528  WerrorS("out of bounds\n");
529  }
530  else if (i<32)
531  {
532  ii=i;
533  if (Sy_bit(ii) & kOptions)
534  {
535  WarnS("Gerhard, use the option command");
536  si_opt_1 |= Sy_bit(ii);
537  }
538  else if (Sy_bit(ii) & validOpts)
539  si_opt_1 |= Sy_bit(ii);
540  }
541  else if (i<64)
542  {
543  ii=i-32;
544  si_opt_2 |= Sy_bit(ii);
545  }
546  else
547  WerrorS("out of bounds\n");
548 }
VAR BITSET validOpts
Definition: kstd1.cc:60
VAR BITSET kOptions
Definition: kstd1.cc:45

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 252 of file ipshell.cc.

253 {
254  BOOLEAN oldShortOut = FALSE;
255 
256  if (currRing != NULL)
257  {
258  oldShortOut = currRing->ShortOut;
259  currRing->ShortOut = 1;
260  }
261  int t=v->Typ();
262  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
263  switch (t)
264  {
265  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
266  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
267  ((intvec*)(v->Data()))->cols()); break;
268  case MATRIX_CMD:Print(" %u x %u\n" ,
269  MATROWS((matrix)(v->Data())),
270  MATCOLS((matrix)(v->Data())));break;
271  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
272  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
273 
274  case PROC_CMD:
275  case RING_CMD:
276  case IDEAL_CMD: PrintLn(); break;
277 
278  //case INT_CMD:
279  //case STRING_CMD:
280  //case INTVEC_CMD:
281  //case POLY_CMD:
282  //case VECTOR_CMD:
283  //case PACKAGE_CMD:
284 
285  default:
286  break;
287  }
288  v->Print();
289  if (currRing != NULL)
290  currRing->ShortOut = oldShortOut;
291 }
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:504

Variable Documentation

◆ iiCurrArgs

VAR leftv iiCurrArgs =NULL

Definition at line 78 of file ipshell.cc.

◆ iiCurrProc

VAR idhdl iiCurrProc =NULL

Definition at line 79 of file ipshell.cc.

◆ iiDebugMarker

VAR BOOLEAN iiDebugMarker =TRUE

Definition at line 988 of file ipshell.cc.

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 82 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 80 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5622 of file ipshell.cc.