1 | #include "Singular/libsingular.h" |
---|
2 | |
---|
3 | #ifdef HAVE_SHIFTBBA |
---|
4 | static BOOLEAN freeAlgebra(leftv res, leftv args) |
---|
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) |
---|
28 | || (rHasLocalOrMixedOrdering(r))) |
---|
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 | |
---|
69 | static BOOLEAN btest(leftv res, leftv h) |
---|
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 | |
---|
82 | static BOOLEAN lpLmDivides(leftv res, leftv h) |
---|
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 | |
---|
113 | static BOOLEAN lpVarAt(leftv res, leftv h) |
---|
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 | |
---|
127 | static BOOLEAN rightStd(leftv res, leftv h) |
---|
128 | { |
---|
129 | const short t[]={1,IDEAL_CMD}; |
---|
130 | if (iiCheckTypes(h,t,1)) |
---|
131 | { |
---|
132 | ideal id=(ideal)h->Data(); |
---|
133 | res->rtyp = IDEAL_CMD; |
---|
134 | res->data = rightgb(id, currRing->qideal); |
---|
135 | return FALSE; |
---|
136 | } |
---|
137 | return TRUE; |
---|
138 | } |
---|
139 | #endif |
---|
140 | |
---|
141 | //------------------------------------------------------------------------ |
---|
142 | // initialisation of the module |
---|
143 | extern "C" int SI_MOD_INIT(freegb)(SModulFunctions* p) |
---|
144 | { |
---|
145 | #ifdef HAVE_SHIFTBBA |
---|
146 | p->iiAddCproc("freealgebra.so","freeAlgebra",FALSE,freeAlgebra); |
---|
147 | p->iiAddCproc("freealgebra.so","lpLmDivides",FALSE,lpLmDivides); |
---|
148 | p->iiAddCproc("freealgebra.so","lpVarAt",FALSE,lpVarAt); |
---|
149 | p->iiAddCproc("freealgebra.so","stest",TRUE,stest); |
---|
150 | p->iiAddCproc("freealgebra.so","btest",TRUE,btest); |
---|
151 | p->iiAddCproc("freealgebra.so","rightstd",FALSE,rightStd); |
---|
152 | #endif |
---|
153 | return (MAX_TOK); |
---|
154 | } |
---|