My Project
Loading...
Searching...
No Matches
gms.cc
Go to the documentation of this file.
1/*****************************************
2* Computer Algebra System SINGULAR *
3*****************************************/
4/*
5* ABSTRACT: Gauss-Manin system normal form
6*/
7
8
9
10
11#include "kernel/mod2.h"
12
13#ifdef HAVE_GMS
14
15#include "gms.h"
16
17#include "coeffs/numbers.h"
18#include "kernel/polys.h"
19
20#include "ipid.h"
21
22lists gmsNF(ideal p,ideal g,matrix B,int D,int K)
23{
24 ideal r=idInit(IDELEMS(p),1);
25 ideal q=idInit(IDELEMS(p),1);
26
28 for(int i=1;i<=MATROWS(B0);i++)
29 for(int j=1;j<=MATCOLS(B0);j++)
30 if(MATELEM(B,i,j)!=NULL)
31 MATELEM(B0,i,j)=pDiff(MATELEM(B,i,j),i+1);
32
33 for(int k=0;k<IDELEMS(p);k++)
34 {
35 while(p->m[k]!=NULL&&pGetExp(p->m[k],1)<=K)
36 {
37 int j=0;
38 while(j<IDELEMS(g)&&!pLmDivisibleBy(g->m[j],p->m[k]))
39 j++;
40
41 if(j<IDELEMS(g))
42 {
43 poly m=pDivideM(pHead(p->m[k]),pHead(g->m[j]));
44 p->m[k]=pSub(p->m[k],ppMult_mm(g->m[j],m));
45 pIncrExp(m,1);
46 pSetm(m);
47 for(int i=0;i<MATROWS(B);i++)
48 {
49 poly m0=pDiff(m,i+2);
50 if(MATELEM(B0,i+1,j+1)!=NULL)
51 p->m[k]=pAdd(p->m[k],ppMult_mm(MATELEM(B0,i+1,j+1),m));
52 if(MATELEM(B,i+1,j+1)!=NULL&&m0!=NULL)
53 p->m[k]=pAdd(p->m[k],ppMult_mm(MATELEM(B,i+1,j+1),m0));
54 pDelete(&m0);
55 }
56 pDelete(&m);
57 }
58 else
59 {
60 poly p0=p->m[k];
61 pIter(p->m[k]);
62 pNext(p0)=NULL;
63 r->m[k]=pAdd(r->m[k],p0);
64 }
65
66 while(p->m[k]!=NULL&&pGetExp(p->m[k],1)<=K&&pWTotaldegree(p->m[k])>D)
67 {
68 int i=pGetExp(p->m[k],1);
69 do
70 {
71 poly p0=p->m[k];
72 pIter(p->m[k]);
73 pNext(p0)=NULL;
74 q->m[k]=pAdd(q->m[k],p0);
75 }while(p->m[k]!=NULL&&pGetExp(p->m[k],1)==i);
76 }
77
78 pNormalize(p->m[k]);
79 }
80
81 q->m[k]=pAdd(q->m[k],p->m[k]);
82 p->m[k]=NULL;
83 }
84 idDelete(&p);
85 idDelete((ideal *)&B0);
86
89
91 l->Init(2);
92
93 l->m[0].rtyp=IDEAL_CMD;
94 l->m[0].data=r;
95 l->m[1].rtyp=IDEAL_CMD;
96 l->m[1].data=q;
97
98 return l;
99}
100
101
103{
104 if(currRingHdl)
105 {
106 if(h&&h->Typ()==IDEAL_CMD)
107 {
108 ideal p=(ideal)h->CopyD();
109 h=h->next;
110 if(h&&h->Typ()==IDEAL_CMD)
111 {
112 ideal g=(ideal)h->Data();
113 h=h->next;
114 if(h&&h->Typ()==MATRIX_CMD)
115 {
116 matrix B=(matrix)h->Data();
117 h=h->next;
118 if(h&&h->Typ()==INT_CMD)
119 {
120 int D=(int)(long)h->Data();
121 h=h->next;
122 if(h&&h->Typ()==INT_CMD)
123 {
124 int K=(int)(long)h->Data();
125 res->rtyp=LIST_CMD;
126 res->data=(void *)gmsNF(p,g,B,D,K);
127 return FALSE;
128 }
129 }
130 }
131 }
132 }
133 WerrorS("<ideal>,<ideal>,<matrix>,<int>,<int> expected");
134 return TRUE;
135 }
136 WerrorS("no ring active");
137 return TRUE;
138}
139
140#endif /* HAVE_GMS */
141
int BOOLEAN
Definition: auxiliary.h:87
#define TRUE
Definition: auxiliary.h:100
#define FALSE
Definition: auxiliary.h:96
int l
Definition: cfEzgcd.cc:100
int m
Definition: cfEzgcd.cc:128
int i
Definition: cfEzgcd.cc:132
int k
Definition: cfEzgcd.cc:99
int p
Definition: cfModGcd.cc:4078
g
Definition: cfModGcd.cc:4090
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:24
CanonicalForm res
Definition: facAbsFact.cc:60
b *CanonicalForm B
Definition: facBivar.cc:52
int j
Definition: facHensel.cc:110
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define D(A)
Definition: gentable.cc:131
lists gmsNF(ideal p, ideal g, matrix B, int D, int K)
Definition: gms.cc:22
@ IDEAL_CMD
Definition: grammar.cc:284
@ MATRIX_CMD
Definition: grammar.cc:286
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
VAR idhdl currRingHdl
Definition: ipid.cc:59
STATIC_VAR Poly * h
Definition: janet.cc:971
VAR omBin slists_bin
Definition: lists.cc:23
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
ip_smatrix * matrix
Definition: matpol.h:43
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27
#define pIter(p)
Definition: monomials.h:37
#define pNext(p)
Definition: monomials.h:36
slists * lists
Definition: mpr_numeric.h:146
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define NULL
Definition: omList.c:12
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Compatibility layer for legacy polynomial operations (over currRing)
#define pAdd(p, q)
Definition: polys.h:203
#define pDelete(p_ptr)
Definition: polys.h:186
#define pHead(p)
returns newly allocated copy of Lm(p), coef is copied, next=NULL, p might be NULL
Definition: polys.h:67
#define pSetm(p)
Definition: polys.h:271
#define ppMult_mm(p, m)
Definition: polys.h:201
#define pDiff(a, b)
Definition: polys.h:296
#define pSub(a, b)
Definition: polys.h:287
#define pDivideM(a, b)
Definition: polys.h:294
#define pIncrExp(p, i)
Definition: polys.h:43
#define pLmDivisibleBy(a, b)
like pDivisibleBy, except that it is assumed that a!=NULL, b!=NULL
Definition: polys.h:140
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pNormalize(p)
Definition: polys.h:317
#define pWTotaldegree(p)
Definition: polys.h:283
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
void id_Normalize(ideal I, const ring r)
normialize all polys in id
#define IDELEMS(i)
Definition: simpleideals.h:23
@ LIST_CMD
Definition: tok.h:118
@ INT_CMD
Definition: tok.h:96