source: git/Singular/wrapper.cc @ 737a68

spielwiese
Last change on this file since 737a68 was 737a68, checked in by Oleksandr Motsak <motsak@…>, 13 years ago
CHG: moved libpolys/polys/polys.h to kernel/polys.h & updated includes ADD: moved (definition of) currRing/rChangeCurrRing to kernel/polys.cc!?
  • Property mode set to 100644
File size: 2.9 KB
Line 
1#include <string.h>
2#include <kernel/mod2.h>
3#include <kernel/febase.h>
4#include <kernel/polys.h>
5#include <kernel/kstd1.h>
6#include <Singular/subexpr.h>
7#include <kernel/ideals.h>
8#include <polys/monomials/ring.h>
9#include <Singular/janet.h>
10
11//extern int (*ListGreatMove)(jList *,jList *,poly);
12extern int ComputeBasis(jList *,jList *);
13extern void Initialization(char *);
14
15BOOLEAN jInitBasis(ideal v, jList **TT,jList **QQ)
16{
17  if (rHasLocalOrMixedOrdering_currRing())
18  {
19    WerrorS("janet only for well-orderings");
20    return TRUE;
21  }
22
23  Initialization(rOrdStr(currRing));
24
25  jList *Q=(jList *)GCM(sizeof(jList));
26  Q->root=NULL;
27
28  jList *T=(jList *)GCM(sizeof(jList));
29  T->root=NULL;
30
31  for (int i=0; i < IDELEMS(v); i++)
32  {
33    if (v->m[i]!=NULL)
34    {
35      Poly *beg=NewPoly(pCopy(v->m[i]));
36
37      InitHistory(beg);
38      InitProl(beg);
39      InitLead(beg);
40
41      InsertInCount(Q,beg);
42    }
43  }
44
45  BOOLEAN r= !(ComputeBasis(T,Q));
46  *TT=T;
47  *QQ=Q;
48  return r;
49}
50
51BOOLEAN jjStdJanetBasis(leftv res, leftv v, int flag)
52{
53  ideal result;
54
55  jList *T;
56  jList *Q;
57  ideal I=(ideal)v->Data();
58  BOOLEAN is_zero=TRUE;
59  for (int i=0; i < IDELEMS(I); i++)
60  {
61    if ((I->m[i]!=NULL)&& (pIsConstant(I->m[i])))
62    {
63      goto zero;
64    }
65    else
66     is_zero=FALSE;
67  }
68  if (is_zero)
69    goto zero;
70  if (!jInitBasis(I,&T,&Q))
71  {
72    int dpO=(strstr(rOrdStr(currRing),"dp")!=NULL);
73    int ideal_length;
74    if (flag==1)
75      ideal_length= dpO ? GB_length() : CountList(T);
76    else
77      ideal_length=CountList(T);
78
79    result=idInit(ideal_length,1);
80
81    int ideal_index=0;
82
83    LCI iT=T->root;
84
85    while(iT)
86    {
87      pTest(iT->info->root);
88      if ((flag==1) && dpO)
89      {
90        //if (pTotaldegree(iT->info->lead) == pTotaldegree(iT->info->history))
91        if (pDeg(iT->info->lead) == pDeg(iT->info->history))
92        {
93          result->m[ideal_length-ideal_index-1]=pCopy(iT->info->root);
94          if (!nGreaterZero(pGetCoeff(iT->info->root)))
95            result->m[ideal_length-ideal_index-1]
96                                  =pNeg(result->m[ideal_length-ideal_index-1]);
97
98          ideal_index++;
99        }
100      }
101      else
102      {
103        result->m[ideal_length-ideal_index-1]=pCopy(iT->info->root);
104        if (!nGreaterZero(pGetCoeff(iT->info->root)))
105          result->m[ideal_length-ideal_index-1]
106                                  =pNeg(result->m[ideal_length-ideal_index-1]);
107
108        ideal_index++;
109      }
110      iT=iT->next;
111    }
112
113    if ((flag==1) && (dpO==0))
114    {
115      //Print ("interred\n");
116      result=kInterRedOld(result);
117      idSkipZeroes(result);
118    }
119    res->data = (char *)result;
120    res->rtyp = IDEAL_CMD;
121    DestroyList(Q);
122    DestroyList(T);
123    return FALSE;
124  }
125  else
126    return TRUE;
127
128zero:
129  result=idInit(1,1);
130  if (!is_zero) result->m[0]=pOne();
131  res->data = (char *)result;
132  res->rtyp = IDEAL_CMD;
133  return FALSE;
134}
135
136BOOLEAN jjJanetBasis(leftv res, leftv v)
137{
138  return jjStdJanetBasis(res,v,0);
139}
Note: See TracBrowser for help on using the repository browser.