freealgebra.cc
Go to the documentation of this file.
1 #include "Singular/libsingular.h"
2 
3 #ifdef HAVE_SHIFTBBA
5 {
6  const short t1[]={2,RING_CMD,INT_CMD};
7  if (iiCheckTypes(args,t1,1))
8  {
9  ring r=(ring)args->Data();
10  int d=(int)(long)args->next->Data();
11  if (d<2)
12  {
13  WerrorS("degree must be >=2");
14  return TRUE;
15  }
16  int i=0;
17  while(r->order[i]!=0)
18  {
19  if ((r->order[i]==ringorder_c) ||(r->order[i]==ringorder_C)) i++;
20  else if ((r->block0[i]==1)&&(r->block1[i]==r->N)) i++;
21  else
22  {
23  WerrorS("only for rings with a global ordering of one block");
24  return TRUE;
25  }
26  }
27  if ((r->order[i]!=0)
29  {
30  WerrorS("only for rings with a global ordering of one block");
31  //Werror("only for rings with a global ordering of one block,i=%d, o=%d",i,r->order[i]);
32  return TRUE;
33  }
34  ring R=freeAlgebra(r,d);
35  res->rtyp=RING_CMD;
36  res->data=R;
37  return R==NULL;
38  }
39  return TRUE;
40 }
41 
42 static BOOLEAN stest(leftv res, leftv args)
43 {
44  const short t[]={2,POLY_CMD,INT_CMD};
45  if (iiCheckTypes(args,t,1))
46  {
47  poly p=(poly)args->CopyD();
48  args=args->next;
49  int sh=(int)((long)(args->Data()));
50  if (sh<0)
51  {
52  WerrorS("negative shift for pLPshift");
53  return TRUE;
54  }
55  int L = pLastVblock(p);
56  if (L+sh > currRing->N/currRing->isLPring)
57  {
58  WerrorS("pLPshift: too big shift requested\n");
59  return TRUE;
60  }
61  p_LPshift(p,sh,currRing);
62  res->data = p;
63  res->rtyp = POLY_CMD;
64  return FALSE;
65  }
66  else return TRUE;
67 }
68 
70 {
71  const short t[]={1,POLY_CMD};
72  if (iiCheckTypes(h,t,1))
73  {
74  poly p=(poly)h->Data();
75  res->rtyp = INT_CMD;
76  res->data = (void*)(long)pLastVblock(p);
77  return FALSE;
78  }
79  else return TRUE;
80 }
81 
83 {
84  const short t1[]={2,POLY_CMD,POLY_CMD};
85  const short t2[]={2,IDEAL_CMD,POLY_CMD};
86  if (iiCheckTypes(h,t1,0))
87  {
88  poly p=(poly)h->Data();
89  poly q=(poly)h->next->Data();
90  res->rtyp = INT_CMD;
91  res->data = (void*)(long)p_LPDivisibleBy(p, q, currRing);
92  return FALSE;
93  }
94  else if (iiCheckTypes(h,t2,1))
95  {
96  ideal I=(ideal)h->Data();
97  poly q=(poly)h->next->Data();
98  res->rtyp = INT_CMD;
99  for(int i=0;i<IDELEMS(I);i++)
100  {
101  if (p_LPDivisibleBy(I->m[i],q, currRing))
102  {
103  res->data=(void*)(long)1;
104  return FALSE;
105  }
106  }
107  res->data=(void*)(long)0;
108  return FALSE;
109  }
110  else return TRUE;
111 }
112 
114 {
115  const short t[]={2,POLY_CMD,INT_CMD};
116  if (iiCheckTypes(h,t,1))
117  {
118  poly p=(poly)h->Data();
119  int pos=(int)((long)(h->next->Data()));
120  res->rtyp = POLY_CMD;
121  res->data = p_LPVarAt(p, pos, currRing);
122  return FALSE;
123  }
124  else return TRUE;
125 }
126 #endif
127 
128 //------------------------------------------------------------------------
129 // initialisation of the module
130 extern "C" int SI_MOD_INIT(freealgebra)(SModulFunctions* p)
131 {
132 #ifdef HAVE_SHIFTBBA
133  p->iiAddCproc("freealgebra.so","freeAlgebra",FALSE,freeAlgebra);
134  p->iiAddCproc("freealgebra.so","lpLmDivides",FALSE,lpLmDivides);
135  p->iiAddCproc("freealgebra.so","lpVarAt",FALSE,lpVarAt);
136  p->iiAddCproc("freealgebra.so","stest",TRUE,stest);
137  p->iiAddCproc("freealgebra.so","btest",TRUE,btest);
138 #endif
139  return (MAX_TOK);
140 }
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:755
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:96
static BOOLEAN btest(leftv res, leftv h)
Definition: freealgebra.cc:69
#define FALSE
Definition: auxiliary.h:96
Definition: tok.h:217
#define TRUE
Definition: auxiliary.h:100
void WerrorS(const char *s)
Definition: feFopen.cc:24
int SI_MOD_INIT() freealgebra(SModulFunctions *p)
Definition: freealgebra.cc:130
void * data
Definition: subexpr.h:88
#define pLastVblock(p)
Definition: shiftop.h:32
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void p_LPshift(poly p, int sh, const ring ri)
Definition: shiftop.cc:387
CanonicalForm res
Definition: facAbsFact.cc:64
static BOOLEAN freeAlgebra(leftv res, leftv args)
Definition: freealgebra.cc:4
int i
Definition: cfEzgcd.cc:125
BOOLEAN p_LPDivisibleBy(poly a, poly b, const ring r)
Definition: shiftop.cc:696
#define IDELEMS(i)
Definition: simpleideals.h:23
leftv next
Definition: subexpr.h:86
poly p_LPVarAt(poly p, int pos, const ring r)
Definition: shiftop.cc:751
STATIC_VAR Poly * h
Definition: janet.cc:971
#define NULL
Definition: omList.c:12
static BOOLEAN stest(leftv res, leftv args)
Definition: freealgebra.cc:42
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:6551
#define R
Definition: sirandom.c:27
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1176
static BOOLEAN lpLmDivides(leftv res, leftv h)
Definition: freealgebra.cc:82
int p
Definition: cfModGcd.cc:4019
int BOOLEAN
Definition: auxiliary.h:87
void * CopyD(int t)
Definition: subexpr.cc:739
static BOOLEAN lpVarAt(leftv res, leftv h)
Definition: freealgebra.cc:113