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

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

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

Functions

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

Variables

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

Macro Definition Documentation

◆ BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH   80

Definition at line 1064 of file ipshell.cc.

Enumeration Type Documentation

◆ semicState

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

Definition at line 3518 of file ipshell.cc.

3519 {
3520  semicOK,
3522 
3525 
3532 
3537 
3543 
3546 
3549 
3550 } semicState;
semicState
Definition: ipshell.cc:3519
@ semicListWrongNumberOfNumerators
Definition: ipshell.cc:3534
@ semicListPGWrong
Definition: ipshell.cc:3548
@ semicListFirstElementWrongType
Definition: ipshell.cc:3526
@ semicListPgNegative
Definition: ipshell.cc:3539
@ semicListSecondElementWrongType
Definition: ipshell.cc:3527
@ semicListMilnorWrong
Definition: ipshell.cc:3547
@ semicListMulNegative
Definition: ipshell.cc:3542
@ semicListFourthElementWrongType
Definition: ipshell.cc:3529
@ semicListWrongNumberOfDenominators
Definition: ipshell.cc:3535
@ semicListNotMonotonous
Definition: ipshell.cc:3545
@ semicListNotSymmetric
Definition: ipshell.cc:3544
@ semicListNNegative
Definition: ipshell.cc:3533
@ semicListDenNegative
Definition: ipshell.cc:3541
@ semicListTooShort
Definition: ipshell.cc:3523
@ semicListTooLong
Definition: ipshell.cc:3524
@ semicListThirdElementWrongType
Definition: ipshell.cc:3528
@ semicListMuNegative
Definition: ipshell.cc:3538
@ semicListNumNegative
Definition: ipshell.cc:3540
@ semicMulNegative
Definition: ipshell.cc:3521
@ semicListWrongNumberOfMultiplicities
Definition: ipshell.cc:3536
@ semicOK
Definition: ipshell.cc:3520
@ semicListFifthElementWrongType
Definition: ipshell.cc:3530
@ semicListSixthElementWrongType
Definition: ipshell.cc:3531

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3634 of file ipshell.cc.

3635 {
3636  spectrumOK,
3637  spectrumZero,
3643  spectrumNoHC,
3645 };
@ spectrumWrongRing
Definition: ipshell.cc:3642
@ spectrumOK
Definition: ipshell.cc:3636
@ spectrumDegenerate
Definition: ipshell.cc:3641
@ spectrumUnspecErr
Definition: ipshell.cc:3644
@ spectrumNotIsolated
Definition: ipshell.cc:3640
@ spectrumBadPoly
Definition: ipshell.cc:3638
@ spectrumNoSingularity
Definition: ipshell.cc:3639
@ spectrumZero
Definition: ipshell.cc:3637
@ spectrumNoHC
Definition: ipshell.cc:3643

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3444 of file ipshell.cc.

3445 {
3446  spec.mu = (int)(long)(l->m[0].Data( ));
3447  spec.pg = (int)(long)(l->m[1].Data( ));
3448  spec.n = (int)(long)(l->m[2].Data( ));
3449 
3450  spec.copy_new( spec.n );
3451 
3452  intvec *num = (intvec*)l->m[3].Data( );
3453  intvec *den = (intvec*)l->m[4].Data( );
3454  intvec *mul = (intvec*)l->m[5].Data( );
3455 
3456  for( int i=0; i<spec.n; i++ )
3457  {
3458  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3459  spec.w[i] = (*mul)[i];
3460  }
3461 }
CanonicalForm num(const CanonicalForm &f)
CanonicalForm den(const CanonicalForm &f)
int l
Definition: cfEzgcd.cc:100
int i
Definition: cfEzgcd.cc:132
Definition: intvec.h:23
int mu
Definition: semic.h:67
void copy_new(int)
Definition: semic.cc:54
Rational * s
Definition: semic.h:70
int n
Definition: semic.h:69
int pg
Definition: semic.h:68
int * w
Definition: semic.h:71

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 552 of file ipshell.cc.

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

3481 {
3483 
3484  L->Init( 6 );
3485 
3486  intvec *num = new intvec( spec.n );
3487  intvec *den = new intvec( spec.n );
3488  intvec *mult = new intvec( spec.n );
3489 
3490  for( int i=0; i<spec.n; i++ )
3491  {
3492  (*num) [i] = spec.s[i].get_num_si( );
3493  (*den) [i] = spec.s[i].get_den_si( );
3494  (*mult)[i] = spec.w[i];
3495  }
3496 
3497  L->m[0].rtyp = INT_CMD; // milnor number
3498  L->m[1].rtyp = INT_CMD; // geometrical genus
3499  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3500  L->m[3].rtyp = INTVEC_CMD; // numerators
3501  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3502  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3503 
3504  L->m[0].data = (void*)(long)spec.mu;
3505  L->m[1].data = (void*)(long)spec.pg;
3506  L->m[2].data = (void*)(long)spec.n;
3507  L->m[3].data = (void*)num;
3508  L->m[4].data = (void*)den;
3509  L->m[5].data = (void*)mult;
3510 
3511  return L;
3512 }
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 6499 of file ipshell.cc.

6500 {
6501  res->Init();
6502  res->rtyp=a->Typ();
6503  switch (res->rtyp /*a->Typ()*/)
6504  {
6505  case INTVEC_CMD:
6506  case INTMAT_CMD:
6507  return iiApplyINTVEC(res,a,op,proc);
6508  case BIGINTMAT_CMD:
6509  return iiApplyBIGINTMAT(res,a,op,proc);
6510  case IDEAL_CMD:
6511  case MODUL_CMD:
6512  case MATRIX_CMD:
6513  return iiApplyIDEAL(res,a,op,proc);
6514  case LIST_CMD:
6515  return iiApplyLIST(res,a,op,proc);
6516  }
6517  WerrorS("first argument to `apply` must allow an index");
6518  return TRUE;
6519 }
#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:6425
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6467
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6462
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6457

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6457 of file ipshell.cc.

6458 {
6459  WerrorS("not implemented");
6460  return TRUE;
6461 }

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6462 of file ipshell.cc.

6463 {
6464  WerrorS("not implemented");
6465  return TRUE;
6466 }

◆ iiApplyINTVEC()

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

Definition at line 6425 of file ipshell.cc.

6426 {
6427  intvec *aa=(intvec*)a->Data();
6428  sleftv tmp_out;
6429  sleftv tmp_in;
6430  leftv curr=res;
6431  BOOLEAN bo=FALSE;
6432  for(int i=0;i<aa->length(); i++)
6433  {
6434  tmp_in.Init();
6435  tmp_in.rtyp=INT_CMD;
6436  tmp_in.data=(void*)(long)(*aa)[i];
6437  if (proc==NULL)
6438  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6439  else
6440  bo=jjPROC(&tmp_out,proc,&tmp_in);
6441  if (bo)
6442  {
6443  res->CleanUp(currRing);
6444  Werror("apply fails at index %d",i+1);
6445  return TRUE;
6446  }
6447  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6448  else
6449  {
6450  curr->next=(leftv)omAllocBin(sleftv_bin);
6451  curr=curr->next;
6452  memcpy(curr,&tmp_out,sizeof(tmp_out));
6453  }
6454  }
6455  return FALSE;
6456 }
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:9049
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 6467 of file ipshell.cc.

6468 {
6469  lists aa=(lists)a->Data();
6470  sleftv tmp_out;
6471  sleftv tmp_in;
6472  leftv curr=res;
6473  BOOLEAN bo=FALSE;
6474  for(int i=0;i<=aa->nr; i++)
6475  {
6476  tmp_in.Init();
6477  tmp_in.Copy(&(aa->m[i]));
6478  if (proc==NULL)
6479  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6480  else
6481  bo=jjPROC(&tmp_out,proc,&tmp_in);
6482  tmp_in.CleanUp();
6483  if (bo)
6484  {
6485  res->CleanUp(currRing);
6486  Werror("apply fails at index %d",i+1);
6487  return TRUE;
6488  }
6489  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6490  else
6491  {
6492  curr->next=(leftv)omAllocBin(sleftv_bin);
6493  curr=curr->next;
6494  memcpy(curr,&tmp_out,sizeof(tmp_out));
6495  }
6496  }
6497  return FALSE;
6498 }
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 6548 of file ipshell.cc.

6549 {
6550  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6551  // find end of s:
6552  int end_s=strlen(s);
6553  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6554  s[end_s+1]='\0';
6555  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6556  sprintf(name,"%s->%s",a,s);
6557  // find start of last expression
6558  int start_s=end_s-1;
6559  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6560  if (start_s<0) // ';' not found
6561  {
6562  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6563  }
6564  else // s[start_s] is ';'
6565  {
6566  s[start_s]='\0';
6567  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6568  }
6569  r->Init();
6570  // now produce procinfo for PROC_CMD:
6571  r->data = (void *)omAlloc0Bin(procinfo_bin);
6572  ((procinfo *)(r->data))->language=LANG_NONE;
6573  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6574  ((procinfo *)r->data)->data.s.body=ss;
6575  omFree(name);
6576  r->rtyp=PROC_CMD;
6577  //r->rtyp=STRING_CMD;
6578  //r->data=ss;
6579  return FALSE;
6580 }
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 6582 of file ipshell.cc.

6583 {
6584  char* ring_name=omStrDup((char*)r->Name());
6585  int t=arg->Typ();
6586  if (t==RING_CMD)
6587  {
6588  sleftv tmp;
6589  tmp.Init();
6590  tmp.rtyp=IDHDL;
6591  idhdl h=rDefault(ring_name);
6592  tmp.data=(char*)h;
6593  if (h!=NULL)
6594  {
6595  tmp.name=h->id;
6596  BOOLEAN b=iiAssign(&tmp,arg);
6597  if (b) return TRUE;
6598  rSetHdl(ggetid(ring_name));
6599  omFree(ring_name);
6600  return FALSE;
6601  }
6602  else
6603  return TRUE;
6604  }
6605  else if (t==CRING_CMD)
6606  {
6607  sleftv tmp;
6608  sleftv n;
6609  n.Init();
6610  n.name=ring_name;
6611  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6612  if (iiAssign(&tmp,arg)) return TRUE;
6613  //Print("create %s\n",r->Name());
6614  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6615  return FALSE;
6616  }
6617  //Print("create %s\n",r->Name());
6618  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6619  return TRUE;// not handled -> error for now
6620 }
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:1202
idhdl rDefault(const char *s)
Definition: ipshell.cc:1650
void rSetHdl(idhdl h)
Definition: ipshell.cc:5210
STATIC_VAR Poly * h
Definition: janet.cc:971
#define omStrDup(s)
Definition: omAllocDecl.h:263
#define IDHDL
Definition: tok.h:31
@ CRING_CMD
Definition: tok.h:56

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1277 of file ipshell.cc.

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

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1636 of file ipshell.cc.

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

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

6641 {
6642  int l=0;
6643  if (args==NULL)
6644  {
6645  if (type_list[0]==0) return TRUE;
6646  }
6647  else l=args->listLength();
6648  if (l!=(int)type_list[0])
6649  {
6650  if (report) iiReportTypes(0,l,type_list);
6651  return FALSE;
6652  }
6653  for(int i=1;i<=l;i++,args=args->next)
6654  {
6655  short t=type_list[i];
6656  if (t!=ANY_TYPE)
6657  {
6658  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6659  || (t!=args->Typ()))
6660  {
6661  if (report) iiReportTypes(i,args->Typ(),type_list);
6662  return FALSE;
6663  }
6664  }
6665  }
6666  return TRUE;
6667 }
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6622
void report(const char *fmt, const char *name)
Definition: shared.cc:666
#define ANY_TYPE
Definition: tok.h:30

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 936 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1202 of file ipshell.cc.

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

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1264 of file ipshell.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1514 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1540 of file ipshell.cc.

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

1613 {
1614  int i;
1615  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1616  poly po=NULL;
1618  {
1619  scComputeHC(I,currRing->qideal,ak,po);
1620  if (po!=NULL)
1621  {
1622  pGetCoeff(po)=nInit(1);
1623  for (i=rVar(currRing); i>0; i--)
1624  {
1625  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1626  }
1627  pSetComp(po,ak);
1628  pSetm(po);
1629  }
1630  }
1631  else
1632  po=pOne();
1633  return po;
1634 }
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:594
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:762

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1416 of file ipshell.cc.

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

◆ iiInternalExport() [2/2]

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

Definition at line 1468 of file ipshell.cc.

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

◆ iiMakeResolv()

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

Definition at line 847 of file ipshell.cc.

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

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 615 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1380 of file ipshell.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

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

◆ iiReportTypes()

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

Definition at line 6622 of file ipshell.cc.

6623 {
6624  char buf[250];
6625  buf[0]='\0';
6626  if (nr==0)
6627  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6628  else
6629  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6630  for(int i=1;i<=T[0];i++)
6631  {
6632  strcat(buf,"`");
6633  strcat(buf,Tok2Cmdname(T[i]));
6634  strcat(buf,"`");
6635  if (i<T[0]) strcat(buf,",");
6636  }
6637  WerrorS(buf);
6638 }
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 6669 of file ipshell.cc.

6670 {
6671  if ((source->next==NULL)&&(source->e==NULL))
6672  {
6673  if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6674  {
6675  memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6676  source->Init();
6677  return;
6678  }
6679  if (source->rtyp==IDHDL)
6680  {
6681  if ((IDLEV((idhdl)source->data)==myynest)
6682  &&(IDTYP((idhdl)source->data)!=RING_CMD))
6683  {
6684  iiRETURNEXPR.Init();
6685  iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6686  iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6687  iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6689  IDATTR((idhdl)source->data)=NULL;
6690  IDDATA((idhdl)source->data)=NULL;
6691  source->name=NULL;
6692  source->attribute=NULL;
6693  return;
6694  }
6695  }
6696  }
6697  iiRETURNEXPR.Copy(source);
6698 }
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 6521 of file ipshell.cc.

6522 {
6523  // assume a: level
6524  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6525  {
6526  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6527  char assume_yylinebuf[80];
6528  strncpy(assume_yylinebuf,my_yylinebuf,79);
6529  int lev=(long)a->Data();
6530  int startlev=0;
6531  idhdl h=ggetid("assumeLevel");
6532  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6533  if(lev <=startlev)
6534  {
6535  BOOLEAN bo=b->Eval();
6536  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6537  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6538  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6539  }
6540  }
6541  b->CleanUp();
6542  a->CleanUp();
6543  return FALSE;
6544 }
#define IDINT(a)
Definition: ipid.h:125

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 88 of file ipshell.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  v 
)

Definition at line 588 of file ipshell.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 967 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3431 of file ipshell.cc.

3432 {
3433  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3434  return (res->data==NULL);
3435 }
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 6363 of file ipshell.cc.

6364 {
6365  if (n==0) n=1;
6366  ideal l=idInit(n,1);
6367  int i;
6368  poly p;
6369  for(i=rVar(currRing);i>0;i--)
6370  {
6371  if (e[i]>0)
6372  {
6373  n--;
6374  p=pOne();
6375  pSetExp(p,i,1);
6376  pSetm(p);
6377  l->m[n]=p;
6378  if (n==0) break;
6379  }
6380  }
6381  res->data=(char*)l;
6382  setFlag(res,FLAG_STD);
6383  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6384 }
#define setFlag(A, F)
Definition: ipid.h:113
#define FLAG_STD
Definition: ipid.h:106
#define pSetExp(p, i, v)
Definition: polys.h:42

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

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

◆ jjPROC()

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

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

3425 {
3426  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3427  (poly)w->CopyD(), currRing);
3428  return errorreported;
3429 }
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 6393 of file ipshell.cc.

6394 {
6395  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6396  ideal I=(ideal)u->Data();
6397  int i;
6398  int n=0;
6399  for(i=I->nrows*I->ncols-1;i>=0;i--)
6400  {
6401  int n0=pGetVariables(I->m[i],e);
6402  if (n0>n) n=n0;
6403  }
6404  jjINT_S_TO_ID(n,e,res);
6405  return FALSE;
6406 }
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6363
#define pGetVariables(p, e)
Definition: polys.h:251

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6385 of file ipshell.cc.

6386 {
6387  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6388  int n=pGetVariables((poly)u->Data(),e);
6389  jjINT_S_TO_ID(n,e,res);
6390  return FALSE;
6391 }

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

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

◆ killlocals0()

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

Definition at line 295 of file ipshell.cc.

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

◆ killlocals_list()

BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 366 of file ipshell.cc.

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

◆ killlocals_rec()

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

Definition at line 330 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3407 of file ipshell.cc.

3408 {
3409  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3410  if (res->data==NULL)
3411  res->data=(char *)new intvec(rVar(currRing));
3412  return FALSE;
3413 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3385 of file ipshell.cc.

3386 {
3387  ideal F=(ideal)id->Data();
3388  intvec * iv = new intvec(rVar(currRing));
3389  polyset s;
3390  int sl, n, i;
3391  int *x;
3392 
3393  res->data=(char *)iv;
3394  s = F->m;
3395  sl = IDELEMS(F) - 1;
3396  n = rVar(currRing);
3397  double wNsqr = (double)2.0 / (double)n;
3399  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3400  wCall(s, sl, x, wNsqr, currRing);
3401  for (i = n; i!=0; i--)
3402  (*iv)[i-1] = x[i + n + 1];
3403  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3404  return FALSE;
3405 }
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 149 of file ipshell.cc.

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

◆ list_cmd()

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

Definition at line 425 of file ipshell.cc.

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

◆ list_error()

void list_error ( semicState  state)

Definition at line 3552 of file ipshell.cc.

3553 {
3554  switch( state )
3555  {
3556  case semicListTooShort:
3557  WerrorS( "the list is too short" );
3558  break;
3559  case semicListTooLong:
3560  WerrorS( "the list is too long" );
3561  break;
3562 
3564  WerrorS( "first element of the list should be int" );
3565  break;
3567  WerrorS( "second element of the list should be int" );
3568  break;
3570  WerrorS( "third element of the list should be int" );
3571  break;
3573  WerrorS( "fourth element of the list should be intvec" );
3574  break;
3576  WerrorS( "fifth element of the list should be intvec" );
3577  break;
3579  WerrorS( "sixth element of the list should be intvec" );
3580  break;
3581 
3582  case semicListNNegative:
3583  WerrorS( "first element of the list should be positive" );
3584  break;
3586  WerrorS( "wrong number of numerators" );
3587  break;
3589  WerrorS( "wrong number of denominators" );
3590  break;
3592  WerrorS( "wrong number of multiplicities" );
3593  break;
3594 
3595  case semicListMuNegative:
3596  WerrorS( "the Milnor number should be positive" );
3597  break;
3598  case semicListPgNegative:
3599  WerrorS( "the geometrical genus should be nonnegative" );
3600  break;
3601  case semicListNumNegative:
3602  WerrorS( "all numerators should be positive" );
3603  break;
3604  case semicListDenNegative:
3605  WerrorS( "all denominators should be positive" );
3606  break;
3607  case semicListMulNegative:
3608  WerrorS( "all multiplicities should be positive" );
3609  break;
3610 
3611  case semicListNotSymmetric:
3612  WerrorS( "it is not symmetric" );
3613  break;
3615  WerrorS( "it is not monotonous" );
3616  break;
3617 
3618  case semicListMilnorWrong:
3619  WerrorS( "the Milnor number is wrong" );
3620  break;
3621  case semicListPGWrong:
3622  WerrorS( "the geometrical genus is wrong" );
3623  break;
3624 
3625  default:
3626  WerrorS( "unspecific error" );
3627  break;
3628  }
3629 }

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4337 of file ipshell.cc.

4338 {
4339  // -------------------
4340  // check list length
4341  // -------------------
4342 
4343  if( l->nr < 5 )
4344  {
4345  return semicListTooShort;
4346  }
4347  else if( l->nr > 5 )
4348  {
4349  return semicListTooLong;
4350  }
4351 
4352  // -------------
4353  // check types
4354  // -------------
4355 
4356  if( l->m[0].rtyp != INT_CMD )
4357  {
4359  }
4360  else if( l->m[1].rtyp != INT_CMD )
4361  {
4363  }
4364  else if( l->m[2].rtyp != INT_CMD )
4365  {
4367  }
4368  else if( l->m[3].rtyp != INTVEC_CMD )
4369  {
4371  }
4372  else if( l->m[4].rtyp != INTVEC_CMD )
4373  {
4375  }
4376  else if( l->m[5].rtyp != INTVEC_CMD )
4377  {
4379  }
4380 
4381  // -------------------------
4382  // check number of entries
4383  // -------------------------
4384 
4385  int mu = (int)(long)(l->m[0].Data( ));
4386  int pg = (int)(long)(l->m[1].Data( ));
4387  int n = (int)(long)(l->m[2].Data( ));
4388 
4389  if( n <= 0 )
4390  {
4391  return semicListNNegative;
4392  }
4393 
4394  intvec *num = (intvec*)l->m[3].Data( );
4395  intvec *den = (intvec*)l->m[4].Data( );
4396  intvec *mul = (intvec*)l->m[5].Data( );
4397 
4398  if( n != num->length( ) )
4399  {
4401  }
4402  else if( n != den->length( ) )
4403  {
4405  }
4406  else if( n != mul->length( ) )
4407  {
4409  }
4410 
4411  // --------
4412  // values
4413  // --------
4414 
4415  if( mu <= 0 )
4416  {
4417  return semicListMuNegative;
4418  }
4419  if( pg < 0 )
4420  {
4421  return semicListPgNegative;
4422  }
4423 
4424  int i;
4425 
4426  for( i=0; i<n; i++ )
4427  {
4428  if( (*num)[i] <= 0 )
4429  {
4430  return semicListNumNegative;
4431  }
4432  if( (*den)[i] <= 0 )
4433  {
4434  return semicListDenNegative;
4435  }
4436  if( (*mul)[i] <= 0 )
4437  {
4438  return semicListMulNegative;
4439  }
4440  }
4441 
4442  // ----------------
4443  // check symmetry
4444  // ----------------
4445 
4446  int j;
4447 
4448  for( i=0, j=n-1; i<=j; i++,j-- )
4449  {
4450  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4451  (*den)[i] != (*den)[j] ||
4452  (*mul)[i] != (*mul)[j] )
4453  {
4454  return semicListNotSymmetric;
4455  }
4456  }
4457 
4458  // ----------------
4459  // check monotony
4460  // ----------------
4461 
4462  for( i=0, j=1; i<n/2; i++,j++ )
4463  {
4464  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4465  {
4466  return semicListNotMonotonous;
4467  }
4468  }
4469 
4470  // ---------------------
4471  // check Milnor number
4472  // ---------------------
4473 
4474  for( mu=0, i=0; i<n; i++ )
4475  {
4476  mu += (*mul)[i];
4477  }
4478 
4479  if( mu != (int)(long)(l->m[0].Data( )) )
4480  {
4481  return semicListMilnorWrong;
4482  }
4483 
4484  // -------------------------
4485  // check geometrical genus
4486  // -------------------------
4487 
4488  for( pg=0, i=0; i<n; i++ )
4489  {
4490  if( (*num)[i]<=(*den)[i] )
4491  {
4492  pg += (*mul)[i];
4493  }
4494  }
4495 
4496  if( pg != (int)(long)(l->m[1].Data( )) )
4497  {
4498  return semicListPGWrong;
4499  }
4500 
4501  return semicOK;
4502 }
void mu(int **points, int sizePoints)

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5163 of file ipshell.cc.

5164 {
5165  int i,j;
5166  int count= self->roots[0]->getAnzRoots(); // number of roots
5167  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5168 
5169  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5170 
5171  if ( self->found_roots )
5172  {
5173  listofroots->Init( count );
5174 
5175  for (i=0; i < count; i++)
5176  {
5177  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5178  onepoint->Init(elem);
5179  for ( j= 0; j < elem; j++ )
5180  {
5181  if ( !rField_is_long_C(currRing) )
5182  {
5183  onepoint->m[j].rtyp=STRING_CMD;
5184  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5185  }
5186  else
5187  {
5188  onepoint->m[j].rtyp=NUMBER_CMD;
5189  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5190  }
5191  onepoint->m[j].next= NULL;
5192  onepoint->m[j].name= NULL;
5193  }
5194  listofroots->m[i].rtyp=LIST_CMD;
5195  listofroots->m[i].data=(void *)onepoint;
5196  listofroots->m[j].next= NULL;
5197  listofroots->m[j].name= NULL;
5198  }
5199 
5200  }
5201  else
5202  {
5203  listofroots->Init( 0 );
5204  }
5205 
5206  return listofroots;
5207 }
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:547
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 4647 of file ipshell.cc.

4648 {
4649  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4650  return FALSE;
4651 }
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 4653 of file ipshell.cc.

4654 {
4655  if ( !(rField_is_long_R(currRing)) )
4656  {
4657  WerrorS("Ground field not implemented!");
4658  return TRUE;
4659  }
4660 
4661  simplex * LP;
4662  matrix m;
4663 
4664  leftv v= args;
4665  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4666  return TRUE;
4667  else
4668  m= (matrix)(v->CopyD());
4669 
4670  LP = new simplex(MATROWS(m),MATCOLS(m));
4671  LP->mapFromMatrix(m);
4672 
4673  v= v->next;
4674  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4675  return TRUE;
4676  else
4677  LP->m= (int)(long)(v->Data());
4678 
4679  v= v->next;
4680  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4681  return TRUE;
4682  else
4683  LP->n= (int)(long)(v->Data());
4684 
4685  v= v->next;
4686  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4687  return TRUE;
4688  else
4689  LP->m1= (int)(long)(v->Data());
4690 
4691  v= v->next;
4692  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4693  return TRUE;
4694  else
4695  LP->m2= (int)(long)(v->Data());
4696 
4697  v= v->next;
4698  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4699  return TRUE;
4700  else
4701  LP->m3= (int)(long)(v->Data());
4702 
4703 #ifdef mprDEBUG_PROT
4704  Print("m (constraints) %d\n",LP->m);
4705  Print("n (columns) %d\n",LP->n);
4706  Print("m1 (<=) %d\n",LP->m1);
4707  Print("m2 (>=) %d\n",LP->m2);
4708  Print("m3 (==) %d\n",LP->m3);
4709 #endif
4710 
4711  LP->compute();
4712 
4713  lists lres= (lists)omAlloc( sizeof(slists) );
4714  lres->Init( 6 );
4715 
4716  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4717  lres->m[0].data=(void*)LP->mapToMatrix(m);
4718 
4719  lres->m[1].rtyp= INT_CMD; // found a solution?
4720  lres->m[1].data=(void*)(long)LP->icase;
4721 
4722  lres->m[2].rtyp= INTVEC_CMD;
4723  lres->m[2].data=(void*)LP->posvToIV();
4724 
4725  lres->m[3].rtyp= INTVEC_CMD;
4726  lres->m[3].data=(void*)LP->zrovToIV();
4727 
4728  lres->m[4].rtyp= INT_CMD;
4729  lres->m[4].data=(void*)(long)LP->m;
4730 
4731  lres->m[5].rtyp= INT_CMD;
4732  lres->m[5].data=(void*)(long)LP->n;
4733 
4734  res->data= (void*)lres;
4735 
4736  return FALSE;
4737 }
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:544

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3155 of file ipshell.cc.

3156 {
3157  int i,j;
3158  matrix result;
3159  ideal id=(ideal)a->Data();
3160 
3161  result =mpNew(IDELEMS(id),rVar(currRing));
3162  for (i=1; i<=IDELEMS(id); i++)
3163  {
3164  for (j=1; j<=rVar(currRing); j++)
3165  {
3166  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3167  }
3168  }
3169  res->data=(char *)result;
3170  return FALSE;
3171 }
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 3177 of file ipshell.cc.

3178 {
3179  int n=(int)(long)b->Data();
3180  int d=(int)(long)c->Data();
3181  int k,l,sign,row,col;
3182  matrix result;
3183  ideal temp;
3184  BOOLEAN bo;
3185  poly p;
3186 
3187  if ((d>n) || (d<1) || (n<1))
3188  {
3189  res->data=(char *)mpNew(1,1);
3190  return FALSE;
3191  }
3192  int *choise = (int*)omAlloc(d*sizeof(int));
3193  if (id==NULL)
3194  temp=idMaxIdeal(1);
3195  else
3196  temp=(ideal)id->Data();
3197 
3198  k = binom(n,d);
3199  l = k*d;
3200  l /= n-d+1;
3201  result =mpNew(l,k);
3202  col = 1;
3203  idInitChoise(d,1,n,&bo,choise);
3204  while (!bo)
3205  {
3206  sign = 1;
3207  for (l=1;l<=d;l++)
3208  {
3209  if (choise[l-1]<=IDELEMS(temp))
3210  {
3211  p = pCopy(temp->m[choise[l-1]-1]);
3212  if (sign == -1) p = pNeg(p);
3213  sign *= -1;
3214  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3215  MATELEM(result,row,col) = p;
3216  }
3217  }
3218  col++;
3219  idGetNextChoise(d,n,&bo,choise);
3220  }
3221  omFreeSize(choise,d*sizeof(int));
3222  if (id==NULL) idDelete(&temp);
3223 
3224  res->data=(char *)result;
3225  return FALSE;
3226 }
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:3377

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

4763 {
4764  poly gls;
4765  gls= (poly)(arg1->Data());
4766  int howclean= (int)(long)arg3->Data();
4767 
4768  if ( gls == NULL || pIsConstant( gls ) )
4769  {
4770  WerrorS("Input polynomial is constant!");
4771  return TRUE;
4772  }
4773 
4774  if (rField_is_Zp(currRing))
4775  {
4776  int* r=Zp_roots(gls, currRing);
4777  lists rlist;
4778  rlist= (lists)omAlloc( sizeof(slists) );
4779  rlist->Init( r[0] );
4780  for(int i=r[0];i>0;i--)
4781  {
4782  rlist->m[i-1].data=n_Init(r[i],currRing);
4783  rlist->m[i-1].rtyp=NUMBER_CMD;
4784  }
4785  omFree(r);
4786  res->data=rlist;
4787  res->rtyp= LIST_CMD;
4788  return FALSE;
4789  }
4790  if ( !(rField_is_R(currRing) ||
4791  rField_is_Q(currRing) ||
4794  {
4795  WerrorS("Ground field not implemented!");
4796  return TRUE;
4797  }
4798 
4801  {
4802  unsigned long int ii = (unsigned long int)arg2->Data();
4803  setGMPFloatDigits( ii, ii );
4804  }
4805 
4806  int ldummy;
4807  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4808  int i,vpos=0;
4809  poly piter;
4810  lists elist;
4811 
4812  elist= (lists)omAlloc( sizeof(slists) );
4813  elist->Init( 0 );
4814 
4815  if ( rVar(currRing) > 1 )
4816  {
4817  piter= gls;
4818  for ( i= 1; i <= rVar(currRing); i++ )
4819  if ( pGetExp( piter, i ) )
4820  {
4821  vpos= i;
4822  break;
4823  }
4824  while ( piter )
4825  {
4826  for ( i= 1; i <= rVar(currRing); i++ )
4827  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4828  {
4829  WerrorS("The input polynomial must be univariate!");
4830  return TRUE;
4831  }
4832  pIter( piter );
4833  }
4834  }
4835 
4836  rootContainer * roots= new rootContainer();
4837  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4838  piter= gls;
4839  for ( i= deg; i >= 0; i-- )
4840  {
4841  if ( piter && pTotaldegree(piter) == i )
4842  {
4843  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4844  //nPrint( pcoeffs[i] );PrintS(" ");
4845  pIter( piter );
4846  }
4847  else
4848  {
4849  pcoeffs[i]= nInit(0);
4850  }
4851  }
4852 
4853 #ifdef mprDEBUG_PROT
4854  for (i=deg; i >= 0; i--)
4855  {
4856  nPrint( pcoeffs[i] );PrintS(" ");
4857  }
4858  PrintLn();
4859 #endif
4860 
4861  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4862  roots->solver( howclean );
4863 
4864  int elem= roots->getAnzRoots();
4865  char *dummy;
4866  int j;
4867 
4868  lists rlist;
4869  rlist= (lists)omAlloc( sizeof(slists) );
4870  rlist->Init( elem );
4871 
4873  {
4874  for ( j= 0; j < elem; j++ )
4875  {
4876  rlist->m[j].rtyp=NUMBER_CMD;
4877  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4878  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4879  }
4880  }
4881  else
4882  {
4883  for ( j= 0; j < elem; j++ )
4884  {
4885  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4886  rlist->m[j].rtyp=STRING_CMD;
4887  rlist->m[j].data=(void *)dummy;
4888  }
4889  }
4890 
4891  elist->Clean();
4892  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4893 
4894  // this is (via fillContainer) the same data as in root
4895  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4896  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4897 
4898  delete roots;
4899 
4900  res->data= (void*)rlist;
4901 
4902  return FALSE;
4903 }
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:520
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:502
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:508

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

4740 {
4741  ideal gls = (ideal)(arg1->Data());
4742  int imtype= (int)(long)arg2->Data();
4743 
4744  uResultant::resMatType mtype= determineMType( imtype );
4745 
4746  // check input ideal ( = polynomial system )
4747  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4748  {
4749  return TRUE;
4750  }
4751 
4752  uResultant *resMat= new uResultant( gls, mtype, false );
4753  if (resMat!=NULL)
4754  {
4755  res->rtyp = MODUL_CMD;
4756  res->data= (void*)resMat->accessResMat()->getMatrix();
4757  if (!errorreported) delete resMat;
4758  }
4759  return errorreported;
4760 }
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 5006 of file ipshell.cc.

5007 {
5008  leftv v= args;
5009 
5010  ideal gls;
5011  int imtype;
5012  int howclean;
5013 
5014  // get ideal
5015  if ( v->Typ() != IDEAL_CMD )
5016  return TRUE;
5017  else gls= (ideal)(v->Data());
5018  v= v->next;
5019 
5020  // get resultant matrix type to use (0,1)
5021  if ( v->Typ() != INT_CMD )
5022  return TRUE;
5023  else imtype= (int)(long)v->Data();
5024  v= v->next;
5025 
5026  if (imtype==0)
5027  {
5028  ideal test_id=idInit(1,1);
5029  int j;
5030  for(j=IDELEMS(gls)-1;j>=0;j--)
5031  {
5032  if (gls->m[j]!=NULL)
5033  {
5034  test_id->m[0]=gls->m[j];
5035  intvec *dummy_w=id_QHomWeight(test_id, currRing);
5036  if (dummy_w!=NULL)
5037  {
5038  WerrorS("Newton polytope not of expected dimension");
5039  delete dummy_w;
5040  return TRUE;
5041  }
5042  }
5043  }
5044  }
5045 
5046  // get and set precision in digits ( > 0 )
5047  if ( v->Typ() != INT_CMD )
5048  return TRUE;
5049  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
5051  {
5052  unsigned long int ii=(unsigned long int)v->Data();
5053  setGMPFloatDigits( ii, ii );
5054  }
5055  v= v->next;
5056 
5057  // get interpolation steps (0,1,2)
5058  if ( v->Typ() != INT_CMD )
5059  return TRUE;
5060  else howclean= (int)(long)v->Data();
5061 
5062  uResultant::resMatType mtype= determineMType( imtype );
5063  int i,count;
5064  lists listofroots= NULL;
5065  number smv= NULL;
5066  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
5067 
5068  //emptylist= (lists)omAlloc( sizeof(slists) );
5069  //emptylist->Init( 0 );
5070 
5071  //res->rtyp = LIST_CMD;
5072  //res->data= (void *)emptylist;
5073 
5074  // check input ideal ( = polynomial system )
5075  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
5076  {
5077  return TRUE;
5078  }
5079 
5080  uResultant * ures;
5081  rootContainer ** iproots;
5082  rootContainer ** muiproots;
5083  rootArranger * arranger;
5084 
5085  // main task 1: setup of resultant matrix
5086  ures= new uResultant( gls, mtype );
5087  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
5088  {
5089  WerrorS("Error occurred during matrix setup!");
5090  return TRUE;
5091  }
5092 
5093  // if dense resultant, check if minor nonsingular
5094  if ( mtype == uResultant::denseResMat )
5095  {
5096  smv= ures->accessResMat()->getSubDet();
5097 #ifdef mprDEBUG_PROT
5098  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
5099 #endif
5100  if ( nIsZero(smv) )
5101  {
5102  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
5103  return TRUE;
5104  }
5105  }
5106 
5107  // main task 2: Interpolate specialized resultant polynomials
5108  if ( interpolate_det )
5109  iproots= ures->interpolateDenseSP( false, smv );
5110  else
5111  iproots= ures->specializeInU( false, smv );
5112 
5113  // main task 3: Interpolate specialized resultant polynomials
5114  if ( interpolate_det )
5115  muiproots= ures->interpolateDenseSP( true, smv );
5116  else
5117  muiproots= ures->specializeInU( true, smv );
5118 
5119 #ifdef mprDEBUG_PROT
5120  int c= iproots[0]->getAnzElems();
5121  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
5122  c= muiproots[0]->getAnzElems();
5123  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
5124 #endif
5125 
5126  // main task 4: Compute roots of specialized polys and match them up
5127  arranger= new rootArranger( iproots, muiproots, howclean );
5128  arranger->solve_all();
5129 
5130  // get list of roots
5131  if ( arranger->success() )
5132  {
5133  arranger->arrange();
5134  listofroots= listOfRoots(arranger, gmp_output_digits );
5135  }
5136  else
5137  {
5138  WerrorS("Solver was unable to find any roots!");
5139  return TRUE;
5140  }
5141 
5142  // free everything
5143  count= iproots[0]->getAnzElems();
5144  for (i=0; i < count; i++) delete iproots[i];
5145  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5146  count= muiproots[0]->getAnzElems();
5147  for (i=0; i < count; i++) delete muiproots[i];
5148  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5149 
5150  delete ures;
5151  delete arranger;
5152  nDelete( &smv );
5153 
5154  res->data= (void *)listofroots;
5155 
5156  //emptylist->Clean();
5157  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5158 
5159  return FALSE;
5160 }
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:5163
#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 4905 of file ipshell.cc.

4906 {
4907  int i;
4908  ideal p,w;
4909  p= (ideal)arg1->Data();
4910  w= (ideal)arg2->Data();
4911 
4912  // w[0] = f(p^0)
4913  // w[1] = f(p^1)
4914  // ...
4915  // p can be a vector of numbers (multivariate polynom)
4916  // or one number (univariate polynom)
4917  // tdg = deg(f)
4918 
4919  int n= IDELEMS( p );
4920  int m= IDELEMS( w );
4921  int tdg= (int)(long)arg3->Data();
4922 
4923  res->data= (void*)NULL;
4924 
4925  // check the input
4926  if ( tdg < 1 )
4927  {
4928  WerrorS("Last input parameter must be > 0!");
4929  return TRUE;
4930  }
4931  if ( n != rVar(currRing) )
4932  {
4933  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4934  return TRUE;
4935  }
4936  if ( m != (int)pow((double)tdg+1,(double)n) )
4937  {
4938  Werror("Size of second input ideal must be equal to %d!",
4939  (int)pow((double)tdg+1,(double)n));
4940  return TRUE;
4941  }
4942  if ( !(rField_is_Q(currRing) /* ||
4943  rField_is_R() || rField_is_long_R() ||
4944  rField_is_long_C()*/ ) )
4945  {
4946  WerrorS("Ground field not implemented!");
4947  return TRUE;
4948  }
4949 
4950  number tmp;
4951  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4952  for ( i= 0; i < n; i++ )
4953  {
4954  pevpoint[i]=nInit(0);
4955  if ( (p->m)[i] )
4956  {
4957  tmp = pGetCoeff( (p->m)[i] );
4958  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4959  {
4960  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4961  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4962  return TRUE;
4963  }
4964  } else tmp= NULL;
4965  if ( !nIsZero(tmp) )
4966  {
4967  if ( !pIsConstant((p->m)[i]))
4968  {
4969  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4970  WerrorS("Elements of first input ideal must be numbers!");
4971  return TRUE;
4972  }
4973  pevpoint[i]= nCopy( tmp );
4974  }
4975  }
4976 
4977  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4978  for ( i= 0; i < m; i++ )
4979  {
4980  wresults[i]= nInit(0);
4981  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4982  {
4983  if ( !pIsConstant((w->m)[i]))
4984  {
4985  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4986  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4987  WerrorS("Elements of second input ideal must be numbers!");
4988  return TRUE;
4989  }
4990  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4991  }
4992  }
4993 
4994  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4995  number *ncpoly= vm.interpolateDense( wresults );
4996  // do not free ncpoly[]!!
4997  poly rpoly= vm.numvec2poly( ncpoly );
4998 
4999  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
5000  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
5001 
5002  res->data= (void*)rpoly;
5003  return FALSE;
5004 }
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 6408 of file ipshell.cc.

6409 {
6410  Print(" %s (",n);
6411  switch (p->language)
6412  {
6413  case LANG_SINGULAR: PrintS("S"); break;
6414  case LANG_C: PrintS("C"); break;
6415  case LANG_TOP: PrintS("T"); break;
6416  case LANG_MAX: PrintS("M"); break;
6417  case LANG_NONE: PrintS("N"); break;
6418  default: PrintS("U");
6419  }
6420  if(p->libname!=NULL)
6421  Print(",%s", p->libname);
6422  PrintS(")");
6423 }
@ 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 2868 of file ipshell.cc.

2869 {
2870  if ((L->nr!=3)
2871 #ifdef HAVE_PLURAL
2872  &&(L->nr!=5)
2873 #endif
2874  )
2875  return NULL;
2876  int is_gf_char=0;
2877  // 0: char/ cf - ring
2878  // 1: list (var)
2879  // 2: list (ord)
2880  // 3: qideal
2881  // possibly:
2882  // 4: C
2883  // 5: D
2884 
2885  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2886 
2887  // ------------------------------------------------------------------
2888  // 0: char:
2889  if (L->m[0].Typ()==CRING_CMD)
2890  {
2891  R->cf=(coeffs)L->m[0].Data();
2892  R->cf->ref++;
2893  }
2894  else if (L->m[0].Typ()==INT_CMD)
2895  {
2896  int ch = (int)(long)L->m[0].Data();
2897  assume( ch >= 0 );
2898 
2899  if (ch == 0) // Q?
2900  R->cf = nInitChar(n_Q, NULL);
2901  else
2902  {
2903  int l = IsPrime(ch); // Zp?
2904  if( l != ch )
2905  {
2906  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2907  ch = l;
2908  }
2909  #ifndef TEST_ZN_AS_ZP
2910  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2911  #else
2912  mpz_t modBase;
2913  mpz_init_set_ui(modBase,(long) ch);
2914  ZnmInfo info;
2915  info.base= modBase;
2916  info.exp= 1;
2917  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2918  R->cf->is_field=1;
2919  R->cf->is_domain=1;
2920  R->cf->has_simple_Inverse=1;
2921  #endif
2922  }
2923  }
2924  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2925  {
2926  lists LL=(lists)L->m[0].Data();
2927 
2928 #ifdef HAVE_RINGS
2929  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2930  {
2931  rComposeRing(LL, R); // Ring!?
2932  }
2933  else
2934 #endif
2935  if (LL->nr < 3)
2936  rComposeC(LL,R); // R, long_R, long_C
2937  else
2938  {
2939  if (LL->m[0].Typ()==INT_CMD)
2940  {
2941  int ch = (int)(long)LL->m[0].Data();
2942  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2943  if (fftable[is_gf_char]==0) is_gf_char=-1;
2944 
2945  if(is_gf_char!= -1)
2946  {
2947  GFInfo param;
2948 
2949  param.GFChar = ch;
2950  param.GFDegree = 1;
2951  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2952 
2953  // nfInitChar should be able to handle the case when ch is in fftables!
2954  R->cf = nInitChar(n_GF, (void*)&param);
2955  }
2956  }
2957 
2958  if( R->cf == NULL )
2959  {
2960  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2961 
2962  if (extRing==NULL)
2963  {
2964  WerrorS("could not create the specified coefficient field");
2965  goto rCompose_err;
2966  }
2967 
2968  if( extRing->qideal != NULL ) // Algebraic extension
2969  {
2970  AlgExtInfo extParam;
2971 
2972  extParam.r = extRing;
2973 
2974  R->cf = nInitChar(n_algExt, (void*)&extParam);
2975  }
2976  else // Transcendental extension
2977  {
2978  TransExtInfo extParam;
2979  extParam.r = extRing;
2980  assume( extRing->qideal == NULL );
2981 
2982  R->cf = nInitChar(n_transExt, &extParam);
2983  }
2984  }
2985  }
2986  }
2987  else
2988  {
2989  WerrorS("coefficient field must be described by `int` or `list`");
2990  goto rCompose_err;
2991  }
2992 
2993  if( R->cf == NULL )
2994  {
2995  WerrorS("could not create coefficient field described by the input!");
2996  goto rCompose_err;
2997  }
2998 
2999  // ------------------------- VARS ---------------------------
3000  if (rComposeVar(L,R)) goto rCompose_err;
3001  // ------------------------ ORDER ------------------------------
3002  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
3003 
3004  // ------------------------ ??????? --------------------
3005 
3006  if (!isLetterplace) rRenameVars(R);
3007  #ifdef HAVE_SHIFTBBA
3008  else
3009  {
3010  R->isLPring=isLetterplace;
3011  R->ShortOut=FALSE;
3012  R->CanShortOut=FALSE;
3013  }
3014  #endif
3015  if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
3016  rComplete(R);
3017 
3018  // ------------------------ Q-IDEAL ------------------------
3019 
3020  if (L->m[3].Typ()==IDEAL_CMD)
3021  {
3022  ideal q=(ideal)L->m[3].Data();
3023  if (q->m[0]!=NULL)
3024  {
3025  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
3026  {
3027  #if 0
3028  WerrorS("coefficient fields must be equal if q-ideal !=0");
3029  goto rCompose_err;
3030  #else
3031  ring orig_ring=currRing;
3032  rChangeCurrRing(R);
3033  int *perm=NULL;
3034  int *par_perm=NULL;
3035  int par_perm_size=0;
3036  nMapFunc nMap;
3037 
3038  if ((nMap=nSetMap(orig_ring->cf))==NULL)
3039  {
3040  if (rEqual(orig_ring,currRing))
3041  {
3042  nMap=n_SetMap(currRing->cf, currRing->cf);
3043  }
3044  else
3045  // Allow imap/fetch to be make an exception only for:
3046  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
3050  ||
3051  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
3052  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
3053  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
3054  {
3055  par_perm_size=rPar(orig_ring);
3056 
3057 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
3058 // naSetChar(rInternalChar(orig_ring),orig_ring);
3059 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
3060 
3061  nSetChar(currRing->cf);
3062  }
3063  else
3064  {
3065  WerrorS("coefficient fields must be equal if q-ideal !=0");
3066  goto rCompose_err;
3067  }
3068  }
3069  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
3070  if (par_perm_size!=0)
3071  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
3072  int i;
3073  #if 0
3074  // use imap:
3075  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
3076  currRing->names,currRing->N,currRing->parameter, currRing->P,
3077  perm,par_perm, currRing->ch);
3078  #else
3079  // use fetch
3080  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
3081  {
3082  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
3083  }
3084  else if (par_perm_size!=0)
3085  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3086  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3087  #endif
3088  ideal dest_id=idInit(IDELEMS(q),1);
3089  for(i=IDELEMS(q)-1; i>=0; i--)
3090  {
3091  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3092  par_perm,par_perm_size);
3093  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3094  pTest(dest_id->m[i]);
3095  }
3096  R->qideal=dest_id;
3097  if (perm!=NULL)
3098  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3099  if (par_perm!=NULL)
3100  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3101  rChangeCurrRing(orig_ring);
3102  #endif
3103  }
3104  else
3105  R->qideal=idrCopyR(q,currRing,R);
3106  }
3107  }
3108  else
3109  {
3110  WerrorS("q-ideal must be given as `ideal`");
3111  goto rCompose_err;
3112  }
3113 
3114 
3115  // ---------------------------------------------------------------
3116  #ifdef HAVE_PLURAL
3117  if (L->nr==5)
3118  {
3119  if (nc_CallPlural((matrix)L->m[4].Data(),
3120  (matrix)L->m[5].Data(),
3121  NULL,NULL,
3122  R,
3123  true, // !!!
3124  true, false,
3125  currRing, FALSE)) goto rCompose_err;
3126  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3127  }
3128  #endif
3129  return R;
3130 
3131 rCompose_err:
3132  if (R->N>0)
3133  {
3134  int i;
3135  if (R->names!=NULL)
3136  {
3137  i=R->N-1;
3138  while (i>=0) { omfree(R->names[i]); i--; }
3139  omFree(R->names);
3140  }
3141  }
3142  omfree(R->order);
3143  omfree(R->block0);
3144  omfree(R->block1);
3145  omfree(R->wvhdl);
3146  omFree(R);
3147  return NULL;
3148 }
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:358
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:2490
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2345
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2576
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2868
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2397
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2531
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:4158
#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:3400
VAR omBin sip_sring_bin
Definition: ring.cc:43
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise,...
Definition: ring.cc:1660
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:531
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:514
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:601
static int rInternalChar(const ring r)
Definition: ring.h:691
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:541
#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 2345 of file ipshell.cc.

2347 {
2348  // ----------------------------------------
2349  // 0: char/ cf - ring
2350  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2351  {
2352  WerrorS("invalid coeff. field description, expecting 0");
2353  return;
2354  }
2355 // R->cf->ch=0;
2356  // ----------------------------------------
2357  // 0, (r1,r2) [, "i" ]
2358  if (L->m[1].rtyp!=LIST_CMD)
2359  {
2360  WerrorS("invalid coeff. field description, expecting precision list");
2361  return;
2362  }
2363  lists LL=(lists)L->m[1].data;
2364  if ((LL->nr!=1)
2365  || (LL->m[0].rtyp!=INT_CMD)
2366  || (LL->m[1].rtyp!=INT_CMD))
2367  {
2368  WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2369  return;
2370  }
2371  int r1=(int)(long)LL->m[0].data;
2372  int r2=(int)(long)LL->m[1].data;
2373  r1=si_min(r1,32767);
2374  r2=si_min(r2,32767);
2375  LongComplexInfo par; memset(&par, 0, sizeof(par));
2376  par.float_len=r1;
2377  par.float_len2=r2;
2378  if (L->nr==2) // complex
2379  {
2380  if (L->m[2].rtyp!=STRING_CMD)
2381  {
2382  WerrorS("invalid coeff. field description, expecting parameter name");
2383  return;
2384  }
2385  par.par_name=(char*)L->m[2].data;
2386  R->cf = nInitChar(n_long_C, &par);
2387  }
2388  else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2389  R->cf = nInitChar(n_R, NULL);
2390  else /* && L->nr==1*/
2391  {
2392  R->cf = nInitChar(n_long_R, &par);
2393  }
2394 }
@ 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 2576 of file ipshell.cc.

2577 {
2578  assume(R!=NULL);
2579  long bitmask=0L;
2580  if (L->m[2].Typ()==LIST_CMD)
2581  {
2582  lists v=(lists)L->m[2].Data();
2583  int n= v->nr+2;
2584  int j_in_R,j_in_L;
2585  // do we have an entry "L",... ?: set bitmask
2586  for (int j=0; j < n-1; j++)
2587  {
2588  if (v->m[j].Typ()==LIST_CMD)
2589  {
2590  lists vv=(lists)v->m[j].Data();
2591  if ((vv->nr==1)
2592  &&(vv->m[0].Typ()==STRING_CMD)
2593  &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2594  {
2595  number nn=(number)vv->m[1].Data();
2596  if (vv->m[1].Typ()==BIGINT_CMD)
2597  bitmask=n_Int(nn,coeffs_BIGINT);
2598  else if (vv->m[1].Typ()==INT_CMD)
2599  bitmask=(long)nn;
2600  else
2601  {
2602  Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2603  return TRUE;
2604  }
2605  break;
2606  }
2607  }
2608  }
2609  if (bitmask!=0) n--;
2610 
2611  // initialize fields of R
2612  R->order=(rRingOrder_t *)omAlloc0((n+1)*sizeof(rRingOrder_t));
2613  R->block0=(int *)omAlloc0((n+1)*sizeof(int));
2614  R->block1=(int *)omAlloc0((n+1)*sizeof(int));
2615  R->wvhdl=(int**)omAlloc0((n+1)*sizeof(int_ptr));
2616  // init order, so that rBlocks works correctly
2617  for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2618  R->order[j_in_R] = ringorder_unspec;
2619  // orderings
2620  for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2621  {
2622  // todo: a(..), M
2623  if (v->m[j_in_L].Typ()!=LIST_CMD)
2624  {
2625  WerrorS("ordering must be list of lists");
2626  return TRUE;
2627  }
2628  lists vv=(lists)v->m[j_in_L].Data();
2629  if ((vv->nr==1)
2630  && (vv->m[0].Typ()==STRING_CMD))
2631  {
2632  if (strcmp((char*)vv->m[0].Data(),"L")==0)
2633  {
2634  j_in_R--;
2635  continue;
2636  }
2637  if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD)
2638  && (vv->m[1].Typ()!=INTMAT_CMD))
2639  {
2640  PrintS(lString(vv));
2641  Werror("ordering name must be a (string,intvec), not (string,%s)",Tok2Cmdname(vv->m[1].Typ()));
2642  return TRUE;
2643  }
2644  R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2645 
2646  if (j_in_R==0) R->block0[0]=1;
2647  else
2648  {
2649  int jj=j_in_R-1;
2650  while((jj>=0)
2651  && ((R->order[jj]== ringorder_a)
2652  || (R->order[jj]== ringorder_aa)
2653  || (R->order[jj]== ringorder_am)
2654  || (R->order[jj]== ringorder_c)
2655  || (R->order[jj]== ringorder_C)
2656  || (R->order[jj]== ringorder_s)
2657  || (R->order[jj]== ringorder_S)
2658  ))
2659  {
2660  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2661  jj--;
2662  }
2663  if (jj<0) R->block0[j_in_R]=1;
2664  else R->block0[j_in_R]=R->block1[jj]+1;
2665  }
2666  intvec *iv;
2667  if (vv->m[1].Typ()==INT_CMD)
2668  {
2669  int l=si_max(1,(int)(long)vv->m[1].Data());
2670  iv=new intvec(l);
2671  for(int i=0;i<l;i++) (*iv)[i]=1;
2672  }
2673  else
2674  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC/INTMAT
2675  int iv_len=iv->length();
2676  if (iv_len==0)
2677  {
2678  Werror("empty intvec for ordering %d (%s)",j_in_R+1,rSimpleOrdStr(R->order[j_in_R]));
2679  return TRUE;
2680  }
2681  if (R->order[j_in_R]==ringorder_M)
2682  {
2683  if (vv->m[1].rtyp==INTMAT_CMD) iv->makeVector();
2684  iv_len=iv->length();
2685  }
2686  if ((R->order[j_in_R]!=ringorder_s)
2687  &&(R->order[j_in_R]!=ringorder_c)
2688  &&(R->order[j_in_R]!=ringorder_C))
2689  {
2690  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2691  if (R->block1[j_in_R]>R->N)
2692  {
2693  if (R->block0[j_in_R]>R->N)
2694  {
2695  Werror("not enough variables for ordering %d (%s)",j_in_R,rSimpleOrdStr(R->order[j_in_R]));
2696  return TRUE;
2697  }
2698  R->block1[j_in_R]=R->N;
2699  iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2700  }
2701  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2702  }
2703  int i;
2704  switch (R->order[j_in_R])
2705  {
2706  case ringorder_ws:
2707  case ringorder_Ws:
2708  R->OrdSgn=-1; // and continue
2709  case ringorder_aa:
2710  case ringorder_a:
2711  case ringorder_wp:
2712  case ringorder_Wp:
2713  R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2714  for (i=0; i<iv_len;i++)
2715  {
2716  R->wvhdl[j_in_R][i]=(*iv)[i];
2717  }
2718  break;
2719  case ringorder_am:
2720  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2721  for (i=0; i<iv_len;i++)
2722  {
2723  R->wvhdl[j_in_R][i]=(*iv)[i];
2724  }
2725  R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2726  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2727  for (; i<iv->length(); i++)
2728  {
2729  R->wvhdl[j_in_R][i+1]=(*iv)[i];
2730  }
2731  break;
2732  case ringorder_M:
2733  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2734  for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2735  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length())));
2736  if (R->block1[j_in_R]>R->N)
2737  {
2738  R->block1[j_in_R]=R->N;
2739  }
2740  break;
2741  case ringorder_ls:
2742  case ringorder_ds:
2743  case ringorder_Ds:
2744  case ringorder_rs:
2745  R->OrdSgn=-1;
2746  case ringorder_lp:
2747  case ringorder_dp:
2748  case ringorder_Dp:
2749  case ringorder_rp:
2750  #if 0
2751  for (i=0; i<iv_len;i++)
2752  {
2753  if (((*iv)[i]!=1)&&(iv_len!=1))
2754  {
2755  iv->show(1);
2756  Warn("ignore weight %d for ord %d (%s) at pos %d\n>>%s<<",
2757  (*iv)[i],j_in_R+1,rSimpleOrdStr(R->order[j_in_R]),i+1,my_yylinebuf);
2758  break;
2759  }
2760  }
2761  #endif // break absfact.tst
2762  break;
2763  case ringorder_S:
2764  break;
2765  case ringorder_c:
2766  case ringorder_C:
2767  R->block1[j_in_R]=R->block0[j_in_R]=0;
2768  break;
2769 
2770  case ringorder_s:
2771  R->block1[j_in_R]=R->block0[j_in_R]=(*iv)[0];
2772  rSetSyzComp(R->block0[j_in_R],R);
2773  break;
2774 
2775  case ringorder_IS:
2776  {
2777  R->block1[j_in_R] = R->block0[j_in_R] = 0;
2778  if( iv->length() > 0 )
2779  {
2780  const int s = (*iv)[0];
2781  assume( -2 < s && s < 2 );
2782  R->block1[j_in_R] = R->block0[j_in_R] = s;
2783  }
2784  break;
2785  }
2786  case 0:
2787  case ringorder_unspec:
2788  break;
2789  case ringorder_L: /* cannot happen */
2790  case ringorder_a64: /*not implemented */
2791  WerrorS("ring order not implemented");
2792  return TRUE;
2793  }
2794  delete iv;
2795  }
2796  else
2797  {
2798  PrintS(lString(vv));
2799  WerrorS("ordering name must be a (string,intvec)");
2800  return TRUE;
2801  }
2802  }
2803  // sanity check
2804  j_in_R=n-2;
2805  if ((R->order[j_in_R]==ringorder_c)
2806  || (R->order[j_in_R]==ringorder_C)
2807  || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2808  if (R->block1[j_in_R] != R->N)
2809  {
2810  if (((R->order[j_in_R]==ringorder_dp) ||
2811  (R->order[j_in_R]==ringorder_ds) ||
2812  (R->order[j_in_R]==ringorder_Dp) ||
2813  (R->order[j_in_R]==ringorder_Ds) ||
2814  (R->order[j_in_R]==ringorder_rp) ||
2815  (R->order[j_in_R]==ringorder_rs) ||
2816  (R->order[j_in_R]==ringorder_lp) ||
2817  (R->order[j_in_R]==ringorder_ls))
2818  &&
2819  R->block0[j_in_R] <= R->N)
2820  {
2821  R->block1[j_in_R] = R->N;
2822  }
2823  else
2824  {
2825  Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2826  return TRUE;
2827  }
2828  }
2829  if (R->block0[j_in_R]>R->N)
2830  {
2831  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2832  for(int ii=0;ii<=j_in_R;ii++)
2833  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2834  return TRUE;
2835  }
2836  if (check_comp)
2837  {
2838  BOOLEAN comp_order=FALSE;
2839  int jj;
2840  for(jj=0;jj<n;jj++)
2841  {
2842  if ((R->order[jj]==ringorder_c) ||
2843  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2844  }
2845  if (!comp_order)
2846  {
2847  R->order=(rRingOrder_t*)omRealloc0Size(R->order,n*sizeof(rRingOrder_t),(n+1)*sizeof(rRingOrder_t));
2848  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2849  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2850  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2851  R->order[n-1]=ringorder_C;
2852  R->block0[n-1]=0;
2853  R->block1[n-1]=0;
2854  R->wvhdl[n-1]=NULL;
2855  n++;
2856  }
2857  }
2858  }
2859  else
2860  {
2861  WerrorS("ordering must be given as `list`");
2862  return TRUE;
2863  }
2864  if (bitmask!=0) { R->bitmask=bitmask; R->wanted_maxExp=bitmask; }
2865  return FALSE;
2866 }
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:506
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:5033
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 2397 of file ipshell.cc.

2399 {
2400  // ----------------------------------------
2401  // 0: string: integer
2402  // no further entries --> Z
2403  mpz_t modBase;
2404  unsigned int modExponent = 1;
2405 
2406  if (L->nr == 0)
2407  {
2408  mpz_init_set_ui(modBase,0);
2409  modExponent = 1;
2410  }
2411  // ----------------------------------------
2412  // 1:
2413  else
2414  {
2415  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2416  lists LL=(lists)L->m[1].data;
2417  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2418  {
2419  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2420  // assume that tmp is integer, not rational
2421  mpz_init(modBase);
2422  n_MPZ (modBase, tmp, coeffs_BIGINT);
2423  }
2424  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2425  {
2426  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2427  }
2428  else
2429  {
2430  mpz_init_set_ui(modBase,0);
2431  }
2432  if (LL->nr >= 1)
2433  {
2434  modExponent = (unsigned long) LL->m[1].data;
2435  }
2436  else
2437  {
2438  modExponent = 1;
2439  }
2440  }
2441  // ----------------------------------------
2442  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
2443  {
2444  WerrorS("Wrong ground ring specification (module is 1)");
2445  return;
2446  }
2447  if (modExponent < 1)
2448  {
2449  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2450  return;
2451  }
2452  // module is 0 ---> integers
2453  if (mpz_sgn1(modBase) == 0)
2454  {
2455  R->cf=nInitChar(n_Z,NULL);
2456  }
2457  // we have an exponent
2458  else if (modExponent > 1)
2459  {
2460  //R->cf->ch = R->cf->modExponent;
2461  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2462  {
2463  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2464  depending on the size of a long on the respective platform */
2465  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2466  }
2467  else
2468  {
2469  //ringtype 3
2470  ZnmInfo info;
2471  info.base= modBase;
2472  info.exp= modExponent;
2473  R->cf=nInitChar(n_Znm,(void*) &info);
2474  }
2475  }
2476  // just a module m > 1
2477  else
2478  {
2479  //ringtype = 2;
2480  //const int ch = mpz_get_ui(modBase);
2481  ZnmInfo info;
2482  info.base= modBase;
2483  info.exp= modExponent;
2484  R->cf=nInitChar(n_Zn,(void*) &info);
2485  }
2486  mpz_clear(modBase);
2487 }
@ 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 2531 of file ipshell.cc.

2532 {
2533  assume(R!=NULL);
2534  if (L->m[1].Typ()==LIST_CMD)
2535  {
2536  lists v=(lists)L->m[1].Data();
2537  R->N = v->nr+1;
2538  if (R->N<=0)
2539  {
2540  WerrorS("no ring variables");
2541  return TRUE;
2542  }
2543  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2544  int i;
2545  for(i=0;i<R->N;i++)
2546  {
2547  if (v->m[i].Typ()==STRING_CMD)
2548  R->names[i]=omStrDup((char *)v->m[i].Data());
2549  else if (v->m[i].Typ()==POLY_CMD)
2550  {
2551  poly p=(poly)v->m[i].Data();
2552  int nr=pIsPurePower(p);
2553  if (nr>0)
2554  R->names[i]=omStrDup(currRing->names[nr-1]);
2555  else
2556  {
2557  Werror("var name %d must be a string or a ring variable",i+1);
2558  return TRUE;
2559  }
2560  }
2561  else
2562  {
2563  Werror("var name %d must be `string` (not %d)",i+1, v->m[i].Typ());
2564  return TRUE;
2565  }
2566  }
2567  }
2568  else
2569  {
2570  WerrorS("variable must be given as `list`");
2571  return TRUE;
2572  }
2573  return FALSE;
2574 }
#define pIsPurePower(p)
Definition: polys.h:248
char * char_ptr
Definition: structs.h:58

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2157 of file ipshell.cc.

2158 {
2159  assume( r != NULL );
2160  const coeffs C = r->cf;
2161  assume( C != NULL );
2162 
2163  // sanity check: require currRing==r for rings with polynomial data
2164  if ( (r!=currRing) && (
2165  (nCoeff_is_algExt(C) && (C != currRing->cf))
2166  || (r->qideal != NULL)
2167 #ifdef HAVE_PLURAL
2168  || (rIsPluralRing(r))
2169 #endif
2170  )
2171  )
2172  {
2173  WerrorS("ring with polynomial data must be the base ring or compatible");
2174  return NULL;
2175  }
2176  // 0: char/ cf - ring
2177  // 1: list (var)
2178  // 2: list (ord)
2179  // 3: qideal
2180  // possibly:
2181  // 4: C
2182  // 5: D
2184  if (rIsPluralRing(r))
2185  L->Init(6);
2186  else
2187  L->Init(4);
2188  // ----------------------------------------
2189  // 0: char/ cf - ring
2190  if (rField_is_numeric(r))
2191  {
2192  rDecomposeC(&(L->m[0]),r);
2193  }
2194  else if (rField_is_Ring(r))
2195  {
2196  rDecomposeRing(&(L->m[0]),r);
2197  }
2198  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2199  {
2200  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2201  }
2202  else if(rField_is_GF(r))
2203  {
2205  Lc->Init(4);
2206  // char:
2207  Lc->m[0].rtyp=INT_CMD;
2208  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2209  // var:
2211  Lv->Init(1);
2212  Lv->m[0].rtyp=STRING_CMD;
2213  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2214  Lc->m[1].rtyp=LIST_CMD;
2215  Lc->m[1].data=(void*)Lv;
2216  // ord:
2218  Lo->Init(1);
2220  Loo->Init(2);
2221  Loo->m[0].rtyp=STRING_CMD;
2222  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2223 
2224  intvec *iv=new intvec(1); (*iv)[0]=1;
2225  Loo->m[1].rtyp=INTVEC_CMD;
2226  Loo->m[1].data=(void *)iv;
2227 
2228  Lo->m[0].rtyp=LIST_CMD;
2229  Lo->m[0].data=(void*)Loo;
2230 
2231  Lc->m[2].rtyp=LIST_CMD;
2232  Lc->m[2].data=(void*)Lo;
2233  // q-ideal:
2234  Lc->m[3].rtyp=IDEAL_CMD;
2235  Lc->m[3].data=(void *)idInit(1,1);
2236  // ----------------------
2237  L->m[0].rtyp=LIST_CMD;
2238  L->m[0].data=(void*)Lc;
2239  }
2240  else
2241  {
2242  L->m[0].rtyp=INT_CMD;
2243  L->m[0].data=(void *)(long)r->cf->ch;
2244  }
2245  // ----------------------------------------
2246  // 1: list (var)
2248  LL->Init(r->N);
2249  int i;
2250  for(i=0; i<r->N; i++)
2251  {
2252  LL->m[i].rtyp=STRING_CMD;
2253  LL->m[i].data=(void *)omStrDup(r->names[i]);
2254  }
2255  L->m[1].rtyp=LIST_CMD;
2256  L->m[1].data=(void *)LL;
2257  // ----------------------------------------
2258  // 2: list (ord)
2260  i=rBlocks(r)-1;
2261  LL->Init(i);
2262  i--;
2263  lists LLL;
2264  for(; i>=0; i--)
2265  {
2266  intvec *iv;
2267  int j;
2268  LL->m[i].rtyp=LIST_CMD;
2270  LLL->Init(2);
2271  LLL->m[0].rtyp=STRING_CMD;
2272  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2273 
2274  if((r->order[i] == ringorder_IS)
2275  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2276  {
2277  assume( r->block0[i] == r->block1[i] );
2278  const int s = r->block0[i];
2279  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2280 
2281  iv=new intvec(1);
2282  (*iv)[0] = s;
2283  }
2284  else if (r->block1[i]-r->block0[i] >=0 )
2285  {
2286  int bl=j=r->block1[i]-r->block0[i];
2287  if (r->order[i]==ringorder_M)
2288  {
2289  j=(j+1)*(j+1)-1;
2290  bl=j+1;
2291  }
2292  else if (r->order[i]==ringorder_am)
2293  {
2294  j+=r->wvhdl[i][bl+1];
2295  }
2296  iv=new intvec(j+1);
2297  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2298  {
2299  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2300  }
2301  else switch (r->order[i])
2302  {
2303  case ringorder_dp:
2304  case ringorder_Dp:
2305  case ringorder_ds:
2306  case ringorder_Ds:
2307  case ringorder_lp:
2308  case ringorder_ls:
2309  case ringorder_rp:
2310  for(;j>=0; j--) (*iv)[j]=1;
2311  break;
2312  default: /* do nothing */;
2313  }
2314  }
2315  else
2316  {
2317  iv=new intvec(1);
2318  }
2319  LLL->m[1].rtyp=INTVEC_CMD;
2320  LLL->m[1].data=(void *)iv;
2321  LL->m[i].data=(void *)LLL;
2322  }
2323  L->m[2].rtyp=LIST_CMD;
2324  L->m[2].data=(void *)LL;
2325  // ----------------------------------------
2326  // 3: qideal
2327  L->m[3].rtyp=IDEAL_CMD;
2328  if (r->qideal==NULL)
2329  L->m[3].data=(void *)idInit(1,1);
2330  else
2331  L->m[3].data=(void *)idCopy(r->qideal);
2332  // ----------------------------------------
2333 #ifdef HAVE_PLURAL // NC! in rDecompose
2334  if (rIsPluralRing(r))
2335  {
2336  L->m[4].rtyp=MATRIX_CMD;
2337  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2338  L->m[5].rtyp=MATRIX_CMD;
2339  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2340  }
2341 #endif
2342  return L;
2343 }
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:1859
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1735
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1923
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:486
static int rBlocks(ring r)
Definition: ring.h:570
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:627
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:517
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:523

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1955 of file ipshell.cc.

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2026 of file ipshell.cc.

2027 {
2028  assume( r != NULL );
2029  const coeffs C = r->cf;
2030  assume( C != NULL );
2031 
2032  // sanity check: require currRing==r for rings with polynomial data
2033  if ( (r!=currRing) && (
2034  (r->qideal != NULL)
2035 #ifdef HAVE_PLURAL
2036  || (rIsPluralRing(r))
2037 #endif
2038  )
2039  )
2040  {
2041  WerrorS("ring with polynomial data must be the base ring or compatible");
2042  return NULL;
2043  }
2044  // 0: char/ cf - ring
2045  // 1: list (var)
2046  // 2: list (ord)
2047  // 3: qideal
2048  // possibly:
2049  // 4: C
2050  // 5: D
2052  if (rIsPluralRing(r))
2053  L->Init(6);
2054  else
2055  L->Init(4);
2056  // ----------------------------------------
2057  // 0: char/ cf - ring
2058  L->m[0].rtyp=CRING_CMD;
2059  L->m[0].data=(char*)r->cf; r->cf->ref++;
2060  // ----------------------------------------
2061  // 1: list (var)
2063  LL->Init(r->N);
2064  int i;
2065  for(i=0; i<r->N; i++)
2066  {
2067  LL->m[i].rtyp=STRING_CMD;
2068  LL->m[i].data=(void *)omStrDup(r->names[i]);
2069  }
2070  L->m[1].rtyp=LIST_CMD;
2071  L->m[1].data=(void *)LL;
2072  // ----------------------------------------
2073  // 2: list (ord)
2075  i=rBlocks(r)-1;
2076  LL->Init(i);
2077  i--;
2078  lists LLL;
2079  for(; i>=0; i--)
2080  {
2081  intvec *iv;
2082  int j;
2083  LL->m[i].rtyp=LIST_CMD;
2085  LLL->Init(2);
2086  LLL->m[0].rtyp=STRING_CMD;
2087  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2088 
2089  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2090  {
2091  assume( r->block0[i] == r->block1[i] );
2092  const int s = r->block0[i];
2093  assume( -2 < s && s < 2);
2094 
2095  iv=new intvec(1);
2096  (*iv)[0] = s;
2097  }
2098  else if (r->block1[i]-r->block0[i] >=0 )
2099  {
2100  int bl=j=r->block1[i]-r->block0[i];
2101  if (r->order[i]==ringorder_M)
2102  {
2103  j=(j+1)*(j+1)-1;
2104  bl=j+1;
2105  }
2106  else if (r->order[i]==ringorder_am)
2107  {
2108  j+=r->wvhdl[i][bl+1];
2109  }
2110  iv=new intvec(j+1);
2111  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2112  {
2113  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2114  }
2115  else switch (r->order[i])
2116  {
2117  case ringorder_dp:
2118  case ringorder_Dp:
2119  case ringorder_ds:
2120  case ringorder_Ds:
2121  case ringorder_lp:
2122  for(;j>=0; j--) (*iv)[j]=1;
2123  break;
2124  default: /* do nothing */;
2125  }
2126  }
2127  else
2128  {
2129  iv=new intvec(1);
2130  }
2131  LLL->m[1].rtyp=INTVEC_CMD;
2132  LLL->m[1].data=(void *)iv;
2133  LL->m[i].data=(void *)LLL;
2134  }
2135  L->m[2].rtyp=LIST_CMD;
2136  L->m[2].data=(void *)LL;
2137  // ----------------------------------------
2138  // 3: qideal
2139  L->m[3].rtyp=IDEAL_CMD;
2140  if (r->qideal==NULL)
2141  L->m[3].data=(void *)idInit(1,1);
2142  else
2143  L->m[3].data=(void *)idCopy(r->qideal);
2144  // ----------------------------------------
2145 #ifdef HAVE_PLURAL // NC! in rDecompose
2146  if (rIsPluralRing(r))
2147  {
2148  L->m[4].rtyp=MATRIX_CMD;
2149  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2150  L->m[5].rtyp=MATRIX_CMD;
2151  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2152  }
2153 #endif
2154  return L;
2155 }

◆ rDecomposeC()

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

Definition at line 1859 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1825 of file ipshell.cc.

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

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

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

◆ rDecomposeRing_41()

void rDecomposeRing_41 ( leftv  h,
const coeffs  C 
)

Definition at line 1895 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1650 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1707 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5709 of file ipshell.cc.

5710 {
5711  int float_len=0;
5712  int float_len2=0;
5713  ring R = NULL;
5714  //BOOLEAN ffChar=FALSE;
5715 
5716  /* ch -------------------------------------------------------*/
5717  // get ch of ground field
5718 
5719  // allocated ring
5720  R = (ring) omAlloc0Bin(sip_sring_bin);
5721 
5722  coeffs cf = NULL;
5723 
5724  assume( pn != NULL );
5725  const int P = pn->listLength();
5726 
5727  if (pn->Typ()==CRING_CMD)
5728  {
5729  cf=(coeffs)pn->CopyD();
5730  leftv pnn=pn;
5731  if(P>1) /*parameter*/
5732  {
5733  pnn = pnn->next;
5734  const int pars = pnn->listLength();
5735  assume( pars > 0 );
5736  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5737 
5738  if (rSleftvList2StringArray(pnn, names))
5739  {
5740  WerrorS("parameter expected");
5741  goto rInitError;
5742  }
5743 
5744  TransExtInfo extParam;
5745 
5746  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5747  for(int i=pars-1; i>=0;i--)
5748  {
5749  omFree(names[i]);
5750  }
5751  omFree(names);
5752 
5753  cf = nInitChar(n_transExt, &extParam);
5754  }
5755  assume( cf != NULL );
5756  }
5757  else if (pn->Typ()==INT_CMD)
5758  {
5759  int ch = (int)(long)pn->Data();
5760  leftv pnn=pn;
5761 
5762  /* parameter? -------------------------------------------------------*/
5763  pnn = pnn->next;
5764 
5765  if (pnn == NULL) // no params!?
5766  {
5767  if (ch!=0)
5768  {
5769  int ch2=IsPrime(ch);
5770  if ((ch<2)||(ch!=ch2))
5771  {
5772  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5773  ch=32003;
5774  }
5775  #ifndef TEST_ZN_AS_ZP
5776  cf = nInitChar(n_Zp, (void*)(long)ch);
5777  #else
5778  mpz_t modBase;
5779  mpz_init_set_ui(modBase, (long)ch);
5780  ZnmInfo info;
5781  info.base= modBase;
5782  info.exp= 1;
5783  cf=nInitChar(n_Zn,(void*) &info);
5784  cf->is_field=1;
5785  cf->is_domain=1;
5786  cf->has_simple_Inverse=1;
5787  #endif
5788  }
5789  else
5790  cf = nInitChar(n_Q, (void*)(long)ch);
5791  }
5792  else
5793  {
5794  const int pars = pnn->listLength();
5795 
5796  assume( pars > 0 );
5797 
5798  // predefined finite field: (p^k, a)
5799  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5800  {
5801  GFInfo param;
5802 
5803  param.GFChar = ch;
5804  param.GFDegree = 1;
5805  param.GFPar_name = pnn->name;
5806 
5807  cf = nInitChar(n_GF, &param);
5808  }
5809  else // (0/p, a, b, ..., z)
5810  {
5811  if ((ch!=0) && (ch!=IsPrime(ch)))
5812  {
5813  WerrorS("too many parameters");
5814  goto rInitError;
5815  }
5816 
5817  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5818 
5819  if (rSleftvList2StringArray(pnn, names))
5820  {
5821  WerrorS("parameter expected");
5822  goto rInitError;
5823  }
5824 
5825  TransExtInfo extParam;
5826 
5827  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5828  for(int i=pars-1; i>=0;i--)
5829  {
5830  omFree(names[i]);
5831  }
5832  omFree(names);
5833 
5834  cf = nInitChar(n_transExt, &extParam);
5835  }
5836  }
5837 
5838  //if (cf==NULL) ->Error: Invalid ground field specification
5839  }
5840  else if ((pn->name != NULL)
5841  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5842  {
5843  leftv pnn=pn->next;
5844  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5845  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5846  {
5847  float_len=(int)(long)pnn->Data();
5848  float_len2=float_len;
5849  pnn=pnn->next;
5850  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5851  {
5852  float_len2=(int)(long)pnn->Data();
5853  pnn=pnn->next;
5854  }
5855  }
5856 
5857  if (!complex_flag)
5858  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5859  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5860  cf=nInitChar(n_R, NULL);
5861  else // longR or longC?
5862  {
5863  LongComplexInfo param;
5864 
5865  param.float_len = si_min (float_len, 32767);
5866  param.float_len2 = si_min (float_len2, 32767);
5867 
5868  // set the parameter name
5869  if (complex_flag)
5870  {
5871  if (param.float_len < SHORT_REAL_LENGTH)
5872  {
5875  }
5876  if ((pnn == NULL) || (pnn->name == NULL))
5877  param.par_name=(const char*)"i"; //default to i
5878  else
5879  param.par_name = (const char*)pnn->name;
5880  }
5881 
5882  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5883  }
5884  assume( cf != NULL );
5885  }
5886 #ifdef HAVE_RINGS
5887  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5888  {
5889  // TODO: change to use coeffs_BIGINT!?
5890  mpz_t modBase;
5891  unsigned int modExponent = 1;
5892  mpz_init_set_si(modBase, 0);
5893  if (pn->next!=NULL)
5894  {
5895  leftv pnn=pn;
5896  if (pnn->next->Typ()==INT_CMD)
5897  {
5898  pnn=pnn->next;
5899  mpz_set_ui(modBase, (long) pnn->Data());
5900  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5901  {
5902  pnn=pnn->next;
5903  modExponent = (long) pnn->Data();
5904  }
5905  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5906  {
5907  pnn=pnn->next;
5908  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5909  }
5910  }
5911  else if (pnn->next->Typ()==BIGINT_CMD)
5912  {
5913  number p=(number)pnn->next->CopyD();
5914  n_MPZ(modBase,p,coeffs_BIGINT);
5916  }
5917  }
5918  else
5919  cf=nInitChar(n_Z,NULL);
5920 
5921  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5922  {
5923  WerrorS("Wrong ground ring specification (module is 1)");
5924  goto rInitError;
5925  }
5926  if (modExponent < 1)
5927  {
5928  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5929  goto rInitError;
5930  }
5931  // module is 0 ---> integers ringtype = 4;
5932  // we have an exponent
5933  if (modExponent > 1 && cf == NULL)
5934  {
5935  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5936  {
5937  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5938  depending on the size of a long on the respective platform */
5939  //ringtype = 1; // Use Z/2^ch
5940  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5941  }
5942  else
5943  {
5944  if (mpz_sgn1(modBase)==0)
5945  {
5946  WerrorS("modulus must not be 0 or parameter not allowed");
5947  goto rInitError;
5948  }
5949  //ringtype = 3;
5950  ZnmInfo info;
5951  info.base= modBase;
5952  info.exp= modExponent;
5953  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5954  }
5955  }
5956  // just a module m > 1
5957  else if (cf == NULL)
5958  {
5959  if (mpz_sgn1(modBase)==0)
5960  {
5961  WerrorS("modulus must not be 0 or parameter not allowed");
5962  goto rInitError;
5963  }
5964  //ringtype = 2;
5965  ZnmInfo info;
5966  info.base= modBase;
5967  info.exp= modExponent;
5968  cf=nInitChar(n_Zn,(void*) &info);
5969  }
5970  assume( cf != NULL );
5971  mpz_clear(modBase);
5972  }
5973 #endif
5974  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5975  else if ((pn->Typ()==RING_CMD) && (P == 1))
5976  {
5977  TransExtInfo extParam;
5978  extParam.r = (ring)pn->Data();
5979  extParam.r->ref++;
5980  cf = nInitChar(n_transExt, &extParam);
5981  }
5982  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5983  //{
5984  // AlgExtInfo extParam;
5985  // extParam.r = (ring)pn->Data();
5986 
5987  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5988  //}
5989  else
5990  {
5991  WerrorS("Wrong or unknown ground field specification");
5992 #if 0
5993 // debug stuff for unknown cf descriptions:
5994  sleftv* p = pn;
5995  while (p != NULL)
5996  {
5997  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5998  PrintLn();
5999  p = p->next;
6000  }
6001 #endif
6002  goto rInitError;
6003  }
6004 
6005  /*every entry in the new ring is initialized to 0*/
6006 
6007  /* characteristic -----------------------------------------------*/
6008  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
6009  * 0 1 : Q(a,...) *names FALSE
6010  * 0 -1 : R NULL FALSE 0
6011  * 0 -1 : R NULL FALSE prec. >6
6012  * 0 -1 : C *names FALSE prec. 0..?
6013  * p p : Fp NULL FALSE
6014  * p -p : Fp(a) *names FALSE
6015  * q q : GF(q=p^n) *names TRUE
6016  */
6017  if (cf==NULL)
6018  {
6019  WerrorS("Invalid ground field specification");
6020  goto rInitError;
6021 // const int ch=32003;
6022 // cf=nInitChar(n_Zp, (void*)(long)ch);
6023  }
6024 
6025  assume( R != NULL );
6026 
6027  R->cf = cf;
6028 
6029  /* names and number of variables-------------------------------------*/
6030  {
6031  int l=rv->listLength();
6032 
6033  if (l>MAX_SHORT)
6034  {
6035  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
6036  goto rInitError;
6037  }
6038  R->N = l; /*rv->listLength();*/
6039  }
6040  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
6041  if (rSleftvList2StringArray(rv, R->names))
6042  {
6043  WerrorS("name of ring variable expected");
6044  goto rInitError;
6045  }
6046 
6047  /* check names and parameters for conflicts ------------------------- */
6048  rRenameVars(R); // conflicting variables will be renamed
6049  /* ordering -------------------------------------------------------------*/
6050  if (rSleftvOrdering2Ordering(ord, R))
6051  goto rInitError;
6052 
6053  // Complete the initialization
6054  if (rComplete(R,1))
6055  goto rInitError;
6056 
6057 /*#ifdef HAVE_RINGS
6058 // currently, coefficients which are ring elements require a global ordering:
6059  if (rField_is_Ring(R) && (R->OrdSgn==-1))
6060  {
6061  WerrorS("global ordering required for these coefficients");
6062  goto rInitError;
6063  }
6064 #endif*/
6065 
6066  rTest(R);
6067 
6068  // try to enter the ring into the name list
6069  // need to clean up sleftv here, before this ring can be set to
6070  // new currRing or currRing can be killed beacuse new ring has
6071  // same name
6072  pn->CleanUp();
6073  rv->CleanUp();
6074  ord->CleanUp();
6075  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
6076  // goto rInitError;
6077 
6078  //memcpy(IDRING(tmp),R,sizeof(*R));
6079  // set current ring
6080  //omFreeBin(R, ip_sring_bin);
6081  //return tmp;
6082  return R;
6083 
6084  // error case:
6085  rInitError:
6086  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
6087  pn->CleanUp();
6088  rv->CleanUp();
6089  ord->CleanUp();
6090  return NULL;
6091 }
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:5697
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5389
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5661
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:449
#define rTest(r)
Definition: ring.h:787

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6301 of file ipshell.cc.

6302 {
6303  ring r = IDRING(h);
6304  int ref=0;
6305  if (r!=NULL)
6306  {
6307  // avoid, that sLastPrinted is the last reference to the base ring:
6308  // clean up before killing the last "named" refrence:
6309  if ((sLastPrinted.rtyp==RING_CMD)
6310  && (sLastPrinted.data==(void*)r))
6311  {
6312  sLastPrinted.CleanUp(r);
6313  }
6314  ref=r->ref;
6315  if ((ref<=0)&&(r==currRing))
6316  {
6317  // cleanup DENOMINATOR_LIST
6318  if (DENOMINATOR_LIST!=NULL)
6319  {
6321  if (TEST_V_ALLWARN)
6322  Warn("deleting denom_list for ring change from %s",IDID(h));
6323  do
6324  {
6325  n_Delete(&(dd->n),currRing->cf);
6326  dd=dd->next;
6328  DENOMINATOR_LIST=dd;
6329  } while(DENOMINATOR_LIST!=NULL);
6330  }
6331  }
6332  rKill(r);
6333  }
6334  if (h==currRingHdl)
6335  {
6336  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6337  else
6338  {
6340  }
6341  }
6342 }
void rKill(ring r)
Definition: ipshell.cc:6255
VAR denominator_list DENOMINATOR_LIST
Definition: kutil.cc:84
denominator_list next
Definition: kutil.h:65

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6255 of file ipshell.cc.

6256 {
6257  if ((r->ref<=0)&&(r->order!=NULL))
6258  {
6259 #ifdef RDEBUG
6260  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6261 #endif
6262  int j;
6263  for (j=0;j<myynest;j++)
6264  {
6265  if (iiLocalRing[j]==r)
6266  {
6267  if (j==0) WarnS("killing the basering for level 0");
6268  iiLocalRing[j]=NULL;
6269  }
6270  }
6271 // any variables depending on r ?
6272  while (r->idroot!=NULL)
6273  {
6274  r->idroot->lev=myynest; // avoid warning about kill global objects
6275  killhdl2(r->idroot,&(r->idroot),r);
6276  }
6277  if (r==currRing)
6278  {
6279  // all dependend stuff is done, clean global vars:
6280  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6282  {
6284  }
6285  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6286  //{
6287  // WerrorS("return value depends on local ring variable (export missing ?)");
6288  // iiRETURNEXPR.CleanUp();
6289  //}
6290  currRing=NULL;
6291  currRingHdl=NULL;
6292  }
6293 
6294  /* nKillChar(r); will be called from inside of rDelete */
6295  rDelete(r);
6296  return;
6297  }
6298  rDecRefCnt(r);
6299 }
#define pDelete(p_ptr)
Definition: polys.h:186

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5270 of file ipshell.cc.

5271 {
5272  // change some bad orderings/combination into better ones
5273  leftv h=ord;
5274  while(h!=NULL)
5275  {
5276  BOOLEAN change=FALSE;
5277  intvec *iv = (intvec *)(h->data);
5278  // ws(-i) -> wp(i)
5279  if ((*iv)[1]==ringorder_ws)
5280  {
5281  BOOLEAN neg=TRUE;
5282  for(int i=2;i<iv->length();i++)
5283  if((*iv)[i]>=0) { neg=FALSE; break; }
5284  if (neg)
5285  {
5286  (*iv)[1]=ringorder_wp;
5287  for(int i=2;i<iv->length();i++)
5288  (*iv)[i]= - (*iv)[i];
5289  change=TRUE;
5290  }
5291  }
5292  // Ws(-i) -> Wp(i)
5293  if ((*iv)[1]==ringorder_Ws)
5294  {
5295  BOOLEAN neg=TRUE;
5296  for(int i=2;i<iv->length();i++)
5297  if((*iv)[i]>=0) { neg=FALSE; break; }
5298  if (neg)
5299  {
5300  (*iv)[1]=ringorder_Wp;
5301  for(int i=2;i<iv->length();i++)
5302  (*iv)[i]= -(*iv)[i];
5303  change=TRUE;
5304  }
5305  }
5306  // wp(1) -> dp
5307  if ((*iv)[1]==ringorder_wp)
5308  {
5309  BOOLEAN all_one=TRUE;
5310  for(int i=2;i<iv->length();i++)
5311  if((*iv)[i]!=1) { all_one=FALSE; break; }
5312  if (all_one)
5313  {
5314  intvec *iv2=new intvec(3);
5315  (*iv2)[0]=1;
5316  (*iv2)[1]=ringorder_dp;
5317  (*iv2)[2]=iv->length()-2;
5318  delete iv;
5319  iv=iv2;
5320  h->data=iv2;
5321  change=TRUE;
5322  }
5323  }
5324  // Wp(1) -> Dp
5325  if ((*iv)[1]==ringorder_Wp)
5326  {
5327  BOOLEAN all_one=TRUE;
5328  for(int i=2;i<iv->length();i++)
5329  if((*iv)[i]!=1) { all_one=FALSE; break; }
5330  if (all_one)
5331  {
5332  intvec *iv2=new intvec(3);
5333  (*iv2)[0]=1;
5334  (*iv2)[1]=ringorder_Dp;
5335  (*iv2)[2]=iv->length()-2;
5336  delete iv;
5337  iv=iv2;
5338  h->data=iv2;
5339  change=TRUE;
5340  }
5341  }
5342  // dp(1)/Dp(1)/rp(1) -> lp(1)
5343  if (((*iv)[1]==ringorder_dp)
5344  || ((*iv)[1]==ringorder_Dp)
5345  || ((*iv)[1]==ringorder_rp))
5346  {
5347  if (iv->length()==3)
5348  {
5349  if ((*iv)[2]==1)
5350  {
5351  if(h->next!=NULL)
5352  {
5353  intvec *iv2 = (intvec *)(h->next->data);
5354  if ((*iv2)[1]==ringorder_lp)
5355  {
5356  (*iv)[1]=ringorder_lp;
5357  change=TRUE;
5358  }
5359  }
5360  }
5361  }
5362  }
5363  // lp(i),lp(j) -> lp(i+j)
5364  if(((*iv)[1]==ringorder_lp)
5365  && (h->next!=NULL))
5366  {
5367  intvec *iv2 = (intvec *)(h->next->data);
5368  if ((*iv2)[1]==ringorder_lp)
5369  {
5370  leftv hh=h->next;
5371  h->next=hh->next;
5372  hh->next=NULL;
5373  if ((*iv2)[0]==1)
5374  (*iv)[2] += 1; // last block unspecified, at least 1
5375  else
5376  (*iv)[2] += (*iv2)[2];
5377  hh->CleanUp();
5378  omFree(hh);
5379  change=TRUE;
5380  }
5381  }
5382  // -------------------
5383  if (!change) h=h->next;
5384  }
5385  return ord;
5386 }

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2490 of file ipshell.cc.

2491 {
2492  int i,j;
2493  BOOLEAN ch;
2494  do
2495  {
2496  ch=0;
2497  for(i=0;i<R->N-1;i++)
2498  {
2499  for(j=i+1;j<R->N;j++)
2500  {
2501  if (strcmp(R->names[i],R->names[j])==0)
2502  {
2503  ch=TRUE;
2504  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);
2505  omFree(R->names[j]);
2506  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2507  sprintf(R->names[j],"@%s",R->names[i]);
2508  }
2509  }
2510  }
2511  }
2512  while (ch);
2513  for(i=0;i<rPar(R); i++)
2514  {
2515  for(j=0;j<R->N;j++)
2516  {
2517  if (strcmp(rParameter(R)[i],R->names[j])==0)
2518  {
2519  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);
2520 // omFree(rParameter(R)[i]);
2521 // rParameter(R)[i]=(char *)omAlloc(10);
2522 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2523  omFree(R->names[j]);
2524  R->names[j]=(char *)omAlloc(10);
2525  sprintf(R->names[j],"@@(%d)",i+1);
2526  }
2527  }
2528  }
2529 }

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5210 of file ipshell.cc.

5211 {
5212  ring rg = NULL;
5213  if (h!=NULL)
5214  {
5215 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5216  rg = IDRING(h);
5217  if (rg==NULL) return; //id <>NULL, ring==NULL
5218  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5219  if (IDID(h)) // OB: ????
5221  rTest(rg);
5222  }
5223  else return;
5224 
5225  // clean up history
5226  if (currRing!=NULL)
5227  {
5229  {
5231  }
5232 
5233  if (rg!=currRing)/*&&(currRing!=NULL)*/
5234  {
5235  if (rg->cf!=currRing->cf)
5236  {
5238  if (DENOMINATOR_LIST!=NULL)
5239  {
5240  if (TEST_V_ALLWARN)
5241  Warn("deleting denom_list for ring change to %s",IDID(h));
5242  do
5243  {
5244  n_Delete(&(dd->n),currRing->cf);
5245  dd=dd->next;
5247  DENOMINATOR_LIST=dd;
5248  } while(DENOMINATOR_LIST!=NULL);
5249  }
5250  }
5251  }
5252  }
5253 
5254  // test for valid "currRing":
5255  if ((rg!=NULL) && (rg->idroot==NULL))
5256  {
5257  ring old=rg;
5258  rg=rAssure_HasComp(rg);
5259  if (old!=rg)
5260  {
5261  rKill(old);
5262  IDRING(h)=rg;
5263  }
5264  }
5265  /*------------ change the global ring -----------------------*/
5266  rChangeCurrRing(rg);
5267  currRingHdl = h;
5268 }
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4600

◆ rSimpleFindHdl()

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

Definition at line 6344 of file ipshell.cc.

6345 {
6346  idhdl h=root;
6347  while (h!=NULL)
6348  {
6349  if ((IDTYP(h)==RING_CMD)
6350  && (h!=n)
6351  && (IDRING(h)==r)
6352  )
6353  {
6354  return h;
6355  }
6356  h=IDNEXT(h);
6357  }
6358  return NULL;
6359 }

◆ rSleftvList2StringArray()

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

Definition at line 5661 of file ipshell.cc.

5662 {
5663 
5664  while(sl!=NULL)
5665  {
5666  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5667  {
5668  *p = omStrDup(sl->Name());
5669  }
5670  else if (sl->name!=NULL)
5671  {
5672  *p = (char*)sl->name;
5673  sl->name=NULL;
5674  }
5675  else if (sl->rtyp==POLY_CMD)
5676  {
5677  sleftv s_sl;
5678  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5679  if (s_sl.name != NULL)
5680  {
5681  *p = (char*)s_sl.name; s_sl.name=NULL;
5682  }
5683  else
5684  *p = NULL;
5685  sl->next = s_sl.next;
5686  s_sl.next = NULL;
5687  s_sl.CleanUp();
5688  if (*p == NULL) return TRUE;
5689  }
5690  else return TRUE;
5691  p++;
5692  sl=sl->next;
5693  }
5694  return FALSE;
5695 }

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5389 of file ipshell.cc.

5390 {
5391  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5392  ord=rOptimizeOrdAsSleftv(ord);
5393  sleftv *sl = ord;
5394 
5395  // determine nBlocks
5396  while (sl!=NULL)
5397  {
5398  intvec *iv = (intvec *)(sl->data);
5399  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5400  i++;
5401  else if ((*iv)[1]==ringorder_L)
5402  {
5403  R->wanted_maxExp=(*iv)[2]*2+1;
5404  n--;
5405  }
5406  else if (((*iv)[1]!=ringorder_a)
5407  && ((*iv)[1]!=ringorder_a64)
5408  && ((*iv)[1]!=ringorder_am))
5409  o++;
5410  n++;
5411  sl=sl->next;
5412  }
5413  // check whether at least one real ordering
5414  if (o==0)
5415  {
5416  WerrorS("invalid combination of orderings");
5417  return TRUE;
5418  }
5419  // if no c/C ordering is given, increment n
5420  if (i==0) n++;
5421  else if (i != 1)
5422  {
5423  // throw error if more than one is given
5424  WerrorS("more than one ordering c/C specified");
5425  return TRUE;
5426  }
5427 
5428  // initialize fields of R
5429  R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
5430  R->block0=(int *)omAlloc0(n*sizeof(int));
5431  R->block1=(int *)omAlloc0(n*sizeof(int));
5432  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5433 
5434  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5435 
5436  // init order, so that rBlocks works correctly
5437  for (j=0; j < n-1; j++)
5438  R->order[j] = ringorder_unspec;
5439  // set last _C order, if no c/C order was given
5440  if (i == 0) R->order[n-2] = ringorder_C;
5441 
5442  /* init orders */
5443  sl=ord;
5444  n=-1;
5445  while (sl!=NULL)
5446  {
5447  intvec *iv;
5448  iv = (intvec *)(sl->data);
5449  if ((*iv)[1]!=ringorder_L)
5450  {
5451  n++;
5452 
5453  /* the format of an ordering:
5454  * iv[0]: factor
5455  * iv[1]: ordering
5456  * iv[2..end]: weights
5457  */
5458  R->order[n] = (rRingOrder_t)((*iv)[1]);
5459  typ=1;
5460  switch ((*iv)[1])
5461  {
5462  case ringorder_ws:
5463  case ringorder_Ws:
5464  typ=-1; // and continue
5465  case ringorder_wp:
5466  case ringorder_Wp:
5467  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5468  R->block0[n] = last+1;
5469  for (i=2; i<iv->length(); i++)
5470  {
5471  R->wvhdl[n][i-2] = (*iv)[i];
5472  last++;
5473  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5474  }
5475  R->block1[n] = si_min(last,R->N);
5476  break;
5477  case ringorder_ls:
5478  case ringorder_ds:
5479  case ringorder_Ds:
5480  case ringorder_rs:
5481  typ=-1; // and continue
5482  case ringorder_lp:
5483  case ringorder_dp:
5484  case ringorder_Dp:
5485  case ringorder_rp:
5486  R->block0[n] = last+1;
5487  if (iv->length() == 3) last+=(*iv)[2];
5488  else last += (*iv)[0];
5489  R->block1[n] = si_min(last,R->N);
5490  if (rCheckIV(iv)) return TRUE;
5491  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5492  {
5493  if (weights[i]==0) weights[i]=typ;
5494  }
5495  break;
5496 
5497  case ringorder_s: // no 'rank' params!
5498  {
5499 
5500  if(iv->length() > 3)
5501  return TRUE;
5502 
5503  if(iv->length() == 3)
5504  {
5505  const int s = (*iv)[2];
5506  R->block0[n] = s;
5507  R->block1[n] = s;
5508  }
5509  break;
5510  }
5511  case ringorder_IS:
5512  {
5513  if(iv->length() != 3) return TRUE;
5514 
5515  const int s = (*iv)[2];
5516 
5517  if( 1 < s || s < -1 ) return TRUE;
5518 
5519  R->block0[n] = s;
5520  R->block1[n] = s;
5521  break;
5522  }
5523  case ringorder_S:
5524  case ringorder_c:
5525  case ringorder_C:
5526  {
5527  if (rCheckIV(iv)) return TRUE;
5528  break;
5529  }
5530  case ringorder_aa:
5531  case ringorder_a:
5532  {
5533  R->block0[n] = last+1;
5534  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5535  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5536  for (i=2; i<iv->length(); i++)
5537  {
5538  R->wvhdl[n][i-2]=(*iv)[i];
5539  last++;
5540  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5541  }
5542  last=R->block0[n]-1;
5543  break;
5544  }
5545  case ringorder_am:
5546  {
5547  R->block0[n] = last+1;
5548  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5549  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5550  if (R->block1[n]- R->block0[n]+2>=iv->length())
5551  WarnS("missing module weights");
5552  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5553  {
5554  R->wvhdl[n][i-2]=(*iv)[i];
5555  last++;
5556  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5557  }
5558  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5559  for (; i<iv->length(); i++)
5560  {
5561  R->wvhdl[n][i-1]=(*iv)[i];
5562  }
5563  last=R->block0[n]-1;
5564  break;
5565  }
5566  case ringorder_a64:
5567  {
5568  R->block0[n] = last+1;
5569  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5570  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5571  int64 *w=(int64 *)R->wvhdl[n];
5572  for (i=2; i<iv->length(); i++)
5573  {
5574  w[i-2]=(*iv)[i];
5575  last++;
5576  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5577  }
5578  last=R->block0[n]-1;
5579  break;
5580  }
5581  case ringorder_M:
5582  {
5583  int Mtyp=rTypeOfMatrixOrder(iv);
5584  if (Mtyp==0) return TRUE;
5585  if (Mtyp==-1) typ = -1;
5586 
5587  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5588  for (i=2; i<iv->length();i++)
5589  R->wvhdl[n][i-2]=(*iv)[i];
5590 
5591  R->block0[n] = last+1;
5592  last += (int)sqrt((double)(iv->length()-2));
5593  R->block1[n] = si_min(last,R->N);
5594  for(i=R->block1[n];i>=R->block0[n];i--)
5595  {
5596  if (weights[i]==0) weights[i]=typ;
5597  }
5598  break;
5599  }
5600 
5601  case ringorder_no:
5602  R->order[n] = ringorder_unspec;
5603  return TRUE;
5604 
5605  default:
5606  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5607  R->order[n] = ringorder_unspec;
5608  return TRUE;
5609  }
5610  }
5611  if (last>R->N)
5612  {
5613  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5614  R->N,last);
5615  return TRUE;
5616  }
5617  sl=sl->next;
5618  }
5619  // find OrdSgn:
5620  R->OrdSgn = 1;
5621  for(i=1;i<=R->N;i++)
5622  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5623  omFree(weights);
5624 
5625  // check for complete coverage
5626  while ( n >= 0 && (
5627  (R->order[n]==ringorder_c)
5628  || (R->order[n]==ringorder_C)
5629  || (R->order[n]==ringorder_s)
5630  || (R->order[n]==ringorder_S)
5631  || (R->order[n]==ringorder_IS)
5632  )) n--;
5633 
5634  assume( n >= 0 );
5635 
5636  if (R->block1[n] != R->N)
5637  {
5638  if (((R->order[n]==ringorder_dp) ||
5639  (R->order[n]==ringorder_ds) ||
5640  (R->order[n]==ringorder_Dp) ||
5641  (R->order[n]==ringorder_Ds) ||
5642  (R->order[n]==ringorder_rp) ||
5643  (R->order[n]==ringorder_rs) ||
5644  (R->order[n]==ringorder_lp) ||
5645  (R->order[n]==ringorder_ls))
5646  &&
5647  R->block0[n] <= R->N)
5648  {
5649  R->block1[n] = R->N;
5650  }
5651  else
5652  {
5653  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5654  R->N,R->block1[n]);
5655  return TRUE;
5656  }
5657  }
5658  return FALSE;
5659 }
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:5270
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 6093 of file ipshell.cc.

6094 {
6095  ring R = rCopy0(org_ring);
6096  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
6097  int n = rBlocks(org_ring), i=0, j;
6098 
6099  /* names and number of variables-------------------------------------*/
6100  {
6101  int l=rv->listLength();
6102  if (l>MAX_SHORT)
6103  {
6104  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
6105  goto rInitError;
6106  }
6107  R->N = l; /*rv->listLength();*/
6108  }
6109  omFree(R->names);
6110  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
6111  if (rSleftvList2StringArray(rv, R->names))
6112  {
6113  WerrorS("name of ring variable expected");
6114  goto rInitError;
6115  }
6116 
6117  /* check names for subring in org_ring ------------------------- */
6118  {
6119  i=0;
6120 
6121  for(j=0;j<R->N;j++)
6122  {
6123  for(;i<org_ring->N;i++)
6124  {
6125  if (strcmp(org_ring->names[i],R->names[j])==0)
6126  {
6127  perm[i+1]=j+1;
6128  break;
6129  }
6130  }
6131  if (i>org_ring->N)
6132  {
6133  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
6134  break;
6135  }
6136  }
6137  }
6138  //Print("perm=");
6139  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
6140  /* ordering -------------------------------------------------------------*/
6141 
6142  for(i=0;i<n;i++)
6143  {
6144  int min_var=-1;
6145  int max_var=-1;
6146  for(j=R->block0[i];j<=R->block1[i];j++)
6147  {
6148  if (perm[j]>0)
6149  {
6150  if (min_var==-1) min_var=perm[j];
6151  max_var=perm[j];
6152  }
6153  }
6154  if (min_var!=-1)
6155  {
6156  //Print("block %d: old %d..%d, now:%d..%d\n",
6157  // i,R->block0[i],R->block1[i],min_var,max_var);
6158  R->block0[i]=min_var;
6159  R->block1[i]=max_var;
6160  if (R->wvhdl[i]!=NULL)
6161  {
6162  omFree(R->wvhdl[i]);
6163  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
6164  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
6165  {
6166  if (perm[j]>0)
6167  {
6168  R->wvhdl[i][perm[j]-R->block0[i]]=
6169  org_ring->wvhdl[i][j-org_ring->block0[i]];
6170  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
6171  }
6172  }
6173  }
6174  }
6175  else
6176  {
6177  if(R->block0[i]>0)
6178  {
6179  //Print("skip block %d\n",i);
6180  R->order[i]=ringorder_unspec;
6181  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
6182  R->wvhdl[i]=NULL;
6183  }
6184  //else Print("keep block %d\n",i);
6185  }
6186  }
6187  i=n-1;
6188  while(i>0)
6189  {
6190  // removed unneded blocks
6191  if(R->order[i-1]==ringorder_unspec)
6192  {
6193  for(j=i;j<=n;j++)
6194  {
6195  R->order[j-1]=R->order[j];
6196  R->block0[j-1]=R->block0[j];
6197  R->block1[j-1]=R->block1[j];
6198  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
6199  R->wvhdl[j-1]=R->wvhdl[j];
6200  }
6201  R->order[n]=ringorder_unspec;
6202  n--;
6203  }
6204  i--;
6205  }
6206  n=rBlocks(org_ring)-1;
6207  while (R->order[n]==0) n--;
6208  while (R->order[n]==ringorder_unspec) n--;
6209  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6210  if (R->block1[n] != R->N)
6211  {
6212  if (((R->order[n]==ringorder_dp) ||
6213  (R->order[n]==ringorder_ds) ||
6214  (R->order[n]==ringorder_Dp) ||
6215  (R->order[n]==ringorder_Ds) ||
6216  (R->order[n]==ringorder_rp) ||
6217  (R->order[n]==ringorder_rs) ||
6218  (R->order[n]==ringorder_lp) ||
6219  (R->order[n]==ringorder_ls))
6220  &&
6221  R->block0[n] <= R->N)
6222  {
6223  R->block1[n] = R->N;
6224  }
6225  else
6226  {
6227  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6228  R->N,R->block1[n],n);
6229  return NULL;
6230  }
6231  }
6232  omFree(perm);
6233  // find OrdSgn:
6234  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6235  //for(i=1;i<=R->N;i++)
6236  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6237  //omFree(weights);
6238  // Complete the initialization
6239  if (rComplete(R,1))
6240  goto rInitError;
6241 
6242  rTest(R);
6243 
6244  if (rv != NULL) rv->CleanUp();
6245 
6246  return R;
6247 
6248  // error case:
6249  rInitError:
6250  if (R != NULL) rDelete(R);
6251  if (rv != NULL) rv->CleanUp();
6252  return NULL;
6253 }
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition: ring.cc:1363

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4635 of file ipshell.cc.

4636 {
4637  sleftv tmp;
4638  tmp.Init();
4639  tmp.rtyp=INT_CMD;
4640  /* tmp.data = (void *)0; -- done by Init */
4641 
4642  return semicProc3(res,u,v,&tmp);
4643 }
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4595

◆ semicProc3()

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

Definition at line 4595 of file ipshell.cc.

4596 {
4597  semicState state;
4598  BOOLEAN qh=(((int)(long)w->Data())==1);
4599 
4600  // -----------------
4601  // check arguments
4602  // -----------------
4603 
4604  lists l1 = (lists)u->Data( );
4605  lists l2 = (lists)v->Data( );
4606 
4607  if( (state=list_is_spectrum( l1 ))!=semicOK )
4608  {
4609  WerrorS( "first argument is not a spectrum" );
4610  list_error( state );
4611  }
4612  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4613  {
4614  WerrorS( "second argument is not a spectrum" );
4615  list_error( state );
4616  }
4617  else
4618  {
4619  spectrum s1= spectrumFromList( l1 );
4620  spectrum s2= spectrumFromList( l2 );
4621 
4622  res->rtyp = INT_CMD;
4623  if (qh)
4624  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4625  else
4626  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4627  }
4628 
4629  // -----------------
4630  // check status
4631  // -----------------
4632 
4633  return (state!=semicOK);
4634 }
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:3552
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3468
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4337

◆ spaddProc()

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

Definition at line 4512 of file ipshell.cc.

4513 {
4514  semicState state;
4515 
4516  // -----------------
4517  // check arguments
4518  // -----------------
4519 
4520  lists l1 = (lists)first->Data( );
4521  lists l2 = (lists)second->Data( );
4522 
4523  if( (state=list_is_spectrum( l1 )) != semicOK )
4524  {
4525  WerrorS( "first argument is not a spectrum:" );
4526  list_error( state );
4527  }
4528  else if( (state=list_is_spectrum( l2 )) != semicOK )
4529  {
4530  WerrorS( "second argument is not a spectrum:" );
4531  list_error( state );
4532  }
4533  else
4534  {
4535  spectrum s1= spectrumFromList ( l1 );
4536  spectrum s2= spectrumFromList ( l2 );
4537  spectrum sum( s1+s2 );
4538 
4539  result->rtyp = LIST_CMD;
4540  result->data = (char*)(getList(sum));
4541  }
4542 
4543  return (state!=semicOK);
4544 }
lists getList(spectrum &spec)
Definition: ipshell.cc:3480

◆ spectrumCompute()

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

Definition at line 3894 of file ipshell.cc.

3895 {
3896  int i;
3897 
3898  #ifdef SPECTRUM_DEBUG
3899  #ifdef SPECTRUM_PRINT
3900  #ifdef SPECTRUM_IOSTREAM
3901  cout << "spectrumCompute\n";
3902  if( fast==0 ) cout << " no optimization" << endl;
3903  if( fast==1 ) cout << " weight optimization" << endl;
3904  if( fast==2 ) cout << " symmetry optimization" << endl;
3905  #else
3906  fputs( "spectrumCompute\n",stdout );
3907  if( fast==0 ) fputs( " no optimization\n", stdout );
3908  if( fast==1 ) fputs( " weight optimization\n", stdout );
3909  if( fast==2 ) fputs( " symmetry optimization\n", stdout );
3910  #endif
3911  #endif
3912  #endif
3913 
3914  // ----------------------
3915  // check if h is zero
3916  // ----------------------
3917 
3918  if( h==(poly)NULL )
3919  {
3920  return spectrumZero;
3921  }
3922 
3923  // ----------------------------------
3924  // check if h has a constant term
3925  // ----------------------------------
3926 
3927  if( hasConstTerm( h, currRing ) )
3928  {
3929  return spectrumBadPoly;
3930  }
3931 
3932  // --------------------------------
3933  // check if h has a linear term
3934  // --------------------------------
3935 
3936  if( hasLinearTerm( h, currRing ) )
3937  {
3938  *L = (lists)omAllocBin( slists_bin);
3939  (*L)->Init( 1 );
3940  (*L)->m[0].rtyp = INT_CMD; // milnor number
3941  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3942 
3943  return spectrumNoSingularity;
3944  }
3945 
3946  // ----------------------------------
3947  // compute the jacobi ideal of (h)
3948  // ----------------------------------
3949 
3950  ideal J = NULL;
3951  J = idInit( rVar(currRing),1 );
3952 
3953  #ifdef SPECTRUM_DEBUG
3954  #ifdef SPECTRUM_PRINT
3955  #ifdef SPECTRUM_IOSTREAM
3956  cout << "\n computing the Jacobi ideal...\n";
3957  #else
3958  fputs( "\n computing the Jacobi ideal...\n",stdout );
3959  #endif
3960  #endif
3961  #endif
3962 
3963  for( i=0; i<rVar(currRing); i++ )
3964  {
3965  J->m[i] = pDiff( h,i+1); //j );
3966 
3967  #ifdef SPECTRUM_DEBUG
3968  #ifdef SPECTRUM_PRINT
3969  #ifdef SPECTRUM_IOSTREAM
3970  cout << " ";
3971  #else
3972  fputs(" ", stdout );
3973  #endif
3974  pWrite( J->m[i] );
3975  #endif
3976  #endif
3977  }
3978 
3979  // --------------------------------------------
3980  // compute a standard basis stdJ of jac(h)
3981  // --------------------------------------------
3982 
3983  #ifdef SPECTRUM_DEBUG
3984  #ifdef SPECTRUM_PRINT
3985  #ifdef SPECTRUM_IOSTREAM
3986  cout << endl;
3987  cout << " computing a standard basis..." << endl;
3988  #else
3989  fputs( "\n", stdout );
3990  fputs( " computing a standard basis...\n", stdout );
3991  #endif
3992  #endif
3993  #endif
3994 
3995  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3996  idSkipZeroes( stdJ );
3997 
3998  #ifdef SPECTRUM_DEBUG
3999  #ifdef SPECTRUM_PRINT
4000  for( i=0; i<IDELEMS(stdJ); i++ )
4001  {
4002  #ifdef SPECTRUM_IOSTREAM
4003  cout << " ";
4004  #else
4005  fputs( " ",stdout );
4006  #endif
4007 
4008  pWrite( stdJ->m[i] );
4009  }
4010  #endif
4011  #endif
4012 
4013  idDelete( &J );
4014 
4015  // ------------------------------------------
4016  // check if the h has a singularity
4017  // ------------------------------------------
4018 
4019  if( hasOne( stdJ, currRing ) )
4020  {
4021  // -------------------------------
4022  // h is smooth in the origin
4023  // return only the Milnor number
4024  // -------------------------------
4025 
4026  *L = (lists)omAllocBin( slists_bin);
4027  (*L)->Init( 1 );
4028  (*L)->m[0].rtyp = INT_CMD; // milnor number
4029  /* (*L)->m[0].data = (void*)0;a -- done by Init */
4030 
4031  return spectrumNoSingularity;
4032  }
4033 
4034  // ------------------------------------------
4035  // check if the singularity h is isolated
4036  // ------------------------------------------
4037 
4038  for( i=rVar(currRing); i>0; i-- )
4039  {
4040  if( hasAxis( stdJ,i, currRing )==FALSE )
4041  {
4042  return spectrumNotIsolated;
4043  }
4044  }
4045 
4046  // ------------------------------------------
4047  // compute the highest corner hc of stdJ
4048  // ------------------------------------------
4049 
4050  #ifdef SPECTRUM_DEBUG
4051  #ifdef SPECTRUM_PRINT
4052  #ifdef SPECTRUM_IOSTREAM
4053  cout << "\n computing the highest corner...\n";
4054  #else
4055  fputs( "\n computing the highest corner...\n", stdout );
4056  #endif
4057  #endif
4058  #endif
4059 
4060  poly hc = (poly)NULL;
4061 
4062  scComputeHC( stdJ,currRing->qideal, 0,hc );
4063 
4064  if( hc!=(poly)NULL )
4065  {
4066  pGetCoeff(hc) = nInit(1);
4067 
4068  for( i=rVar(currRing); i>0; i-- )
4069  {
4070  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
4071  }
4072  pSetm( hc );
4073  }
4074  else
4075  {
4076  return spectrumNoHC;
4077  }
4078 
4079  #ifdef SPECTRUM_DEBUG
4080  #ifdef SPECTRUM_PRINT
4081  #ifdef SPECTRUM_IOSTREAM
4082  cout << " ";
4083  #else
4084  fputs( " ", stdout );
4085  #endif
4086  pWrite( hc );
4087  #endif
4088  #endif
4089 
4090  // ----------------------------------------
4091  // compute the Newton polygon nph of h
4092  // ----------------------------------------
4093 
4094  #ifdef SPECTRUM_DEBUG
4095  #ifdef SPECTRUM_PRINT
4096  #ifdef SPECTRUM_IOSTREAM
4097  cout << "\n computing the newton polygon...\n";
4098  #else
4099  fputs( "\n computing the newton polygon...\n", stdout );
4100  #endif
4101  #endif
4102  #endif
4103 
4104  newtonPolygon nph( h, currRing );
4105 
4106  #ifdef SPECTRUM_DEBUG
4107  #ifdef SPECTRUM_PRINT
4108  cout << nph;
4109  #endif
4110  #endif
4111 
4112  // -----------------------------------------------
4113  // compute the weight corner wc of (stdj,nph)
4114  // -----------------------------------------------
4115 
4116  #ifdef SPECTRUM_DEBUG
4117  #ifdef SPECTRUM_PRINT
4118  #ifdef SPECTRUM_IOSTREAM
4119  cout << "\n computing the weight corner...\n";
4120  #else
4121  fputs( "\n computing the weight corner...\n", stdout );
4122  #endif
4123  #endif
4124  #endif
4125 
4126  poly wc = ( fast==0 ? pCopy( hc ) :
4127  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
4128  /* fast==2 */computeWC( nph,
4129  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
4130 
4131  #ifdef SPECTRUM_DEBUG
4132  #ifdef SPECTRUM_PRINT
4133  #ifdef SPECTRUM_IOSTREAM
4134  cout << " ";
4135  #else
4136  fputs( " ", stdout );
4137  #endif
4138  pWrite( wc );
4139  #endif
4140  #endif
4141 
4142  // -------------
4143  // compute NF
4144  // -------------
4145 
4146  #ifdef SPECTRUM_DEBUG
4147  #ifdef SPECTRUM_PRINT
4148  #ifdef SPECTRUM_IOSTREAM
4149  cout << "\n computing NF...\n" << endl;
4150  #else
4151  fputs( "\n computing NF...\n", stdout );
4152  #endif
4153  #endif
4154  #endif
4155 
4156  spectrumPolyList NF( &nph );
4157 
4158  computeNF( stdJ,hc,wc,&NF, currRing );
4159 
4160  #ifdef SPECTRUM_DEBUG
4161  #ifdef SPECTRUM_PRINT
4162  cout << NF;
4163  #ifdef SPECTRUM_IOSTREAM
4164  cout << endl;
4165  #else
4166  fputs( "\n", stdout );
4167  #endif
4168  #endif
4169  #endif
4170 
4171  // ----------------------------
4172  // compute the spectrum of h
4173  // ----------------------------
4174 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4175 
4176  return spectrumStateFromList(NF, L, fast );
4177 }
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition: ipshell.cc:3653
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:2430
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 4268 of file ipshell.cc.

4269 {
4270  spectrumState state = spectrumOK;
4271 
4272  // -------------------
4273  // check consistency
4274  // -------------------
4275 
4276  // check for a local polynomial ring
4277 
4278  if( currRing->OrdSgn != -1 )
4279  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4280  // or should we use:
4281  //if( !ringIsLocal( ) )
4282  {
4283  WerrorS( "only works for local orderings" );
4284  state = spectrumWrongRing;
4285  }
4286  else if( currRing->qideal != NULL )
4287  {
4288  WerrorS( "does not work in quotient rings" );
4289  state = spectrumWrongRing;
4290  }
4291  else
4292  {
4293  lists L = (lists)NULL;
4294  int flag = 2; // symmetric optimization
4295 
4296  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4297 
4298  if( state==spectrumOK )
4299  {
4300  result->rtyp = LIST_CMD;
4301  result->data = (char*)L;
4302  }
4303  else
4304  {
4305  spectrumPrintError(state);
4306  }
4307  }
4308 
4309  return (state!=spectrumOK);
4310 }
spectrumState
Definition: ipshell.cc:3635
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3894
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4186

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3468 of file ipshell.cc.

3469 {
3470  spectrum result;
3471  copy_deep( result, l );
3472  return result;
3473 }
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3444

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4186 of file ipshell.cc.

4187 {
4188  switch( state )
4189  {
4190  case spectrumZero:
4191  WerrorS( "polynomial is zero" );
4192  break;
4193  case spectrumBadPoly:
4194  WerrorS( "polynomial has constant term" );
4195  break;
4196  case spectrumNoSingularity:
4197  WerrorS( "not a singularity" );
4198  break;
4199  case spectrumNotIsolated:
4200  WerrorS( "the singularity is not isolated" );
4201  break;
4202  case spectrumNoHC:
4203  WerrorS( "highest corner cannot be computed" );
4204  break;
4205  case spectrumDegenerate:
4206  WerrorS( "principal part is degenerate" );
4207  break;
4208  case spectrumOK:
4209  break;
4210 
4211  default:
4212  WerrorS( "unknown error occurred" );
4213  break;
4214  }
4215 }

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4217 of file ipshell.cc.

4218 {
4219  spectrumState state = spectrumOK;
4220 
4221  // -------------------
4222  // check consistency
4223  // -------------------
4224 
4225  // check for a local ring
4226 
4227  if( !ringIsLocal(currRing ) )
4228  {
4229  WerrorS( "only works for local orderings" );
4230  state = spectrumWrongRing;
4231  }
4232 
4233  // no quotient rings are allowed
4234 
4235  else if( currRing->qideal != NULL )
4236  {
4237  WerrorS( "does not work in quotient rings" );
4238  state = spectrumWrongRing;
4239  }
4240  else
4241  {
4242  lists L = (lists)NULL;
4243  int flag = 1; // weight corner optimization is safe
4244 
4245  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4246 
4247  if( state==spectrumOK )
4248  {
4249  result->rtyp = LIST_CMD;
4250  result->data = (char*)L;
4251  }
4252  else
4253  {
4254  spectrumPrintError(state);
4255  }
4256  }
4257 
4258  return (state!=spectrumOK);
4259 }
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461

◆ spectrumStateFromList()

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

Definition at line 3653 of file ipshell.cc.

3654 {
3655  spectrumPolyNode **node = &speclist.root;
3657 
3658  poly f,tmp;
3659  int found,cmp;
3660 
3661  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3662  ( fast==2 ? 2 : 1 ) );
3663 
3664  Rational weight_prev( 0,1 );
3665 
3666  int mu = 0; // the milnor number
3667  int pg = 0; // the geometrical genus
3668  int n = 0; // number of different spectral numbers
3669  int z = 0; // number of spectral number equal to smax
3670 
3671  while( (*node)!=(spectrumPolyNode*)NULL &&
3672  ( fast==0 || (*node)->weight<=smax ) )
3673  {
3674  // ---------------------------------------
3675  // determine the first normal form which
3676  // contains the monomial node->mon
3677  // ---------------------------------------
3678 
3679  found = FALSE;
3680  search = *node;
3681 
3682  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3683  {
3684  if( search->nf!=(poly)NULL )
3685  {
3686  f = search->nf;
3687 
3688  do
3689  {
3690  // --------------------------------
3691  // look for (*node)->mon in f
3692  // --------------------------------
3693 
3694  cmp = pCmp( (*node)->mon,f );
3695 
3696  if( cmp<0 )
3697  {
3698  f = pNext( f );
3699  }
3700  else if( cmp==0 )
3701  {
3702  // -----------------------------
3703  // we have found a normal form
3704  // -----------------------------
3705 
3706  found = TRUE;
3707 
3708  // normalize coefficient
3709 
3710  number inv = nInvers( pGetCoeff( f ) );
3711  search->nf=__p_Mult_nn( search->nf,inv,currRing );
3712  nDelete( &inv );
3713 
3714  // exchange normal forms
3715 
3716  tmp = (*node)->nf;
3717  (*node)->nf = search->nf;
3718  search->nf = tmp;
3719  }
3720  }
3721  while( cmp<0 && f!=(poly)NULL );
3722  }
3723  search = search->next;
3724  }
3725 
3726  if( found==FALSE )
3727  {
3728  // ------------------------------------------------
3729  // the weight of node->mon is a spectrum number
3730  // ------------------------------------------------
3731 
3732  mu++;
3733 
3734  if( (*node)->weight<=(Rational)1 ) pg++;
3735  if( (*node)->weight==smax ) z++;
3736  if( (*node)->weight>weight_prev ) n++;
3737 
3738  weight_prev = (*node)->weight;
3739  node = &((*node)->next);
3740  }
3741  else
3742  {
3743  // -----------------------------------------------
3744  // determine all other normal form which contain
3745  // the monomial node->mon
3746  // replace for node->mon its normal form
3747  // -----------------------------------------------
3748 
3749  while( search!=(spectrumPolyNode*)NULL )
3750  {
3751  if( search->nf!=(poly)NULL )
3752  {
3753  f = search->nf;
3754 
3755  do
3756  {
3757  // --------------------------------
3758  // look for (*node)->mon in f
3759  // --------------------------------
3760 
3761  cmp = pCmp( (*node)->mon,f );
3762 
3763  if( cmp<0 )
3764  {
3765  f = pNext( f );
3766  }
3767  else if( cmp==0 )
3768  {
3769  search->nf = pSub( search->nf,
3770  __pp_Mult_nn( (*node)->nf,pGetCoeff( f ),currRing ) );
3771  pNorm( search->nf );
3772  }
3773  }
3774  while( cmp<0 && f!=(poly)NULL );
3775  }
3776  search = search->next;
3777  }
3778  speclist.delete_node( node );
3779  }
3780 
3781  }
3782 
3783  // --------------------------------------------------------
3784  // fast computation exploits the symmetry of the spectrum
3785  // --------------------------------------------------------
3786 
3787  if( fast==2 )
3788  {
3789  mu = 2*mu - z;
3790  n = ( z > 0 ? 2*n - 1 : 2*n );
3791  }
3792 
3793  // --------------------------------------------------------
3794  // compute the spectrum numbers with their multiplicities
3795  // --------------------------------------------------------
3796 
3797  intvec *nom = new intvec( n );
3798  intvec *den = new intvec( n );
3799  intvec *mult = new intvec( n );
3800 
3801  int count = 0;
3802  int multiplicity = 1;
3803 
3804  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3805  ( fast==0 || search->weight<=smax );
3806  search=search->next )
3807  {
3808  if( search->next==(spectrumPolyNode*)NULL ||
3809  search->weight<search->next->weight )
3810  {
3811  (*nom) [count] = search->weight.get_num_si( );
3812  (*den) [count] = search->weight.get_den_si( );
3813  (*mult)[count] = multiplicity;
3814 
3815  multiplicity=1;
3816  count++;
3817  }
3818  else
3819  {
3820  multiplicity++;
3821  }
3822  }
3823 
3824  // --------------------------------------------------------
3825  // fast computation exploits the symmetry of the spectrum
3826  // --------------------------------------------------------
3827 
3828  if( fast==2 )
3829  {
3830  int n1,n2;
3831  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3832  {
3833  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3834  (*den) [n2] = (*den)[n1];
3835  (*mult)[n2] = (*mult)[n1];
3836  }
3837  }
3838 
3839  // -----------------------------------
3840  // test if the spectrum is symmetric
3841  // -----------------------------------
3842 
3843  if( fast==0 || fast==1 )
3844  {
3845  int symmetric=TRUE;
3846 
3847  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3848  {
3849  if( (*mult)[n1]!=(*mult)[n2] ||
3850  (*den) [n1]!= (*den)[n2] ||
3851  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3852  {
3853  symmetric = FALSE;
3854  }
3855  }
3856 
3857  if( symmetric==FALSE )
3858  {
3859  // ---------------------------------------------
3860  // the spectrum is not symmetric => degenerate
3861  // principal part
3862  // ---------------------------------------------
3863 
3864  *L = (lists)omAllocBin( slists_bin);
3865  (*L)->Init( 1 );
3866  (*L)->m[0].rtyp = INT_CMD; // milnor number
3867  (*L)->m[0].data = (void*)(long)mu;
3868 
3869  return spectrumDegenerate;
3870  }
3871  }
3872 
3873  *L = (lists)omAllocBin( slists_bin);
3874 
3875  (*L)->Init( 6 );
3876 
3877  (*L)->m[0].rtyp = INT_CMD; // milnor number
3878  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3879  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3880  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3881  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3882  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3883 
3884  (*L)->m[0].data = (void*)(long)mu;
3885  (*L)->m[1].data = (void*)(long)pg;
3886  (*L)->m[2].data = (void*)(long)n;
3887  (*L)->m[3].data = (void*)nom;
3888  (*L)->m[4].data = (void*)den;
3889  (*L)->m[5].data = (void*)mult;
3890 
3891  return spectrumOK;
3892 }
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 4554 of file ipshell.cc.

4555 {
4556  semicState state;
4557 
4558  // -----------------
4559  // check arguments
4560  // -----------------
4561 
4562  lists l = (lists)first->Data( );
4563  int k = (int)(long)second->Data( );
4564 
4565  if( (state=list_is_spectrum( l ))!=semicOK )
4566  {
4567  WerrorS( "first argument is not a spectrum" );
4568  list_error( state );
4569  }
4570  else if( k < 0 )
4571  {
4572  WerrorS( "second argument should be positive" );
4573  state = semicMulNegative;
4574  }
4575  else
4576  {
4578  spectrum product( k*s );
4579 
4580  result->rtyp = LIST_CMD;
4581  result->data = (char*)getList(product);
4582  }
4583 
4584  return (state!=semicOK);
4585 }

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3256 of file ipshell.cc.

3257 {
3258  sleftv tmp;
3259  tmp.Init();
3260  tmp.rtyp=INT_CMD;
3261  tmp.data=(void *)1;
3262  return syBetti2(res,u,&tmp);
3263 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3233

◆ syBetti2()

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

Definition at line 3233 of file ipshell.cc.

3234 {
3235  syStrategy syzstr=(syStrategy)u->Data();
3236 
3237  BOOLEAN minim=(int)(long)w->Data();
3238  int row_shift=0;
3239  int add_row_shift=0;
3240  intvec *weights=NULL;
3241  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3242  if (ww!=NULL)
3243  {
3244  weights=ivCopy(ww);
3245  add_row_shift = ww->min_in();
3246  (*weights) -= add_row_shift;
3247  }
3248 
3249  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3250  //row_shift += add_row_shift;
3251  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3252  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3253 
3254  return FALSE;
3255 }
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 3340 of file ipshell.cc.

3341 {
3342  int typ0;
3344 
3345  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3346  if (fr != NULL)
3347  {
3348 
3349  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3350  for (int i=result->length-1;i>=0;i--)
3351  {
3352  if (fr[i]!=NULL)
3353  result->fullres[i] = idCopy(fr[i]);
3354  }
3355  result->list_length=result->length;
3356  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3357  }
3358  else
3359  {
3360  omFreeSize(result, sizeof(ssyStrategy));
3361  result = NULL;
3362  }
3363  return result;
3364 }

◆ syConvRes()

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

Definition at line 3268 of file ipshell.cc.

3269 {
3270  resolvente fullres = syzstr->fullres;
3271  resolvente minres = syzstr->minres;
3272 
3273  const int length = syzstr->length;
3274 
3275  if ((fullres==NULL) && (minres==NULL))
3276  {
3277  if (syzstr->hilb_coeffs==NULL)
3278  { // La Scala
3279  fullres = syReorder(syzstr->res, length, syzstr);
3280  }
3281  else
3282  { // HRES
3283  minres = syReorder(syzstr->orderedRes, length, syzstr);
3284  syKillEmptyEntres(minres, length);
3285  }
3286  }
3287 
3288  resolvente tr;
3289  int typ0=IDEAL_CMD;
3290 
3291  if (minres!=NULL)
3292  tr = minres;
3293  else
3294  tr = fullres;
3295 
3296  resolvente trueres=NULL;
3297  intvec ** w=NULL;
3298 
3299  if (length>0)
3300  {
3301  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3302  for (int i=length-1;i>=0;i--)
3303  {
3304  if (tr[i]!=NULL)
3305  {
3306  trueres[i] = idCopy(tr[i]);
3307  }
3308  }
3309  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3310  typ0 = MODUL_CMD;
3311  if (syzstr->weights!=NULL)
3312  {
3313  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3314  for (int i=length-1;i>=0;i--)
3315  {
3316  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3317  }
3318  }
3319  }
3320 
3321  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3322  w, add_row_shift);
3323 
3324  if (toDel)
3325  syKillComputation(syzstr);
3326  else
3327  {
3328  if( fullres != NULL && syzstr->fullres == NULL )
3329  syzstr->fullres = fullres;
3330 
3331  if( minres != NULL && syzstr->minres == NULL )
3332  syzstr->minres = minres;
3333  }
3334  return li;
3335 }
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 3369 of file ipshell.cc.

3370 {
3371  int typ0;
3373 
3374  resolvente fr = liFindRes(li,&(result->length),&typ0);
3375  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3376  for (int i=result->length-1;i>=0;i--)
3377  {
3378  if (fr[i]!=NULL)
3379  result->minres[i] = idCopy(fr[i]);
3380  }
3381  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3382  return result;
3383 }

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 514 of file ipshell.cc.

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

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 254 of file ipshell.cc.

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

Variable Documentation

◆ iiCurrArgs

VAR leftv iiCurrArgs =NULL

Definition at line 80 of file ipshell.cc.

◆ iiCurrProc

VAR idhdl iiCurrProc =NULL

Definition at line 81 of file ipshell.cc.

◆ iiDebugMarker

VAR BOOLEAN iiDebugMarker =TRUE

Definition at line 1063 of file ipshell.cc.

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 84 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 82 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5697 of file ipshell.cc.