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