source: git/Singular/lists.cc @ aad4ca4

spielwiese
Last change on this file since aad4ca4 was aad4ca4, checked in by Hans Schoenemann <hannes@…>, 6 years ago
format: Warn -> WarnS, trailing spaces
  • Property mode set to 100644
File size: 8.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: handling of the list type
6*/
7// to produce a non-inline version from lists.h
8#define LISTS_CC
9
10
11
12
13#include "kernel/mod2.h"
14#include "Singular/tok.h"
15//#include "ipid.h"
16#include "kernel/polys.h"
17#include "kernel/ideals.h"
18#include "Singular/attrib.h"
19#include "Singular/ipshell.h"
20#include "misc/intvec.h"
21#include "Singular/lists.h"
22
23omBin slists_bin = omGetSpecBin(sizeof(slists));
24
25int lSize(lists L)
26{
27  int n=L->nr;
28   while ((n>=0)&&((L->m[n].rtyp==DEF_CMD)||(L->m[n].rtyp==0))) n--;
29  return n;
30}
31
32lists lCopy(lists L)
33{
34  lists N=(lists)omAlloc0Bin(slists_bin);
35  int n=L->nr;
36  if (L->nr>=0)
37    N->Init(n+1);
38  else
39    N->Init();
40  for(;n>=0;n--)
41  {
42    N->m[n].Copy(&L->m[n]);
43  }
44  //Print("copy list with %d -> %d elems\n",L->nr,N->nr);
45  return N;
46}
47
48/*2
49* concat 2 lists
50*/
51BOOLEAN lAdd(leftv res, leftv u, leftv v)
52{
53  lists l=(lists) omAllocBin(slists_bin);
54  lists ul=(lists)u->CopyD();
55  lists vl=(lists)v->CopyD();
56  l->Init(ul->nr+vl->nr+2);
57  int i;
58
59  for(i=0;i<=ul->nr;i++)
60  {
61    //Print("u[%d]->r[%d]\n",i,i);
62    l->m[i].rtyp=ul->m[i].rtyp;
63    l->m[i].data=ul->m[i].data;
64  }
65  for(i=0;i<=vl->nr;i++)
66  {
67    //Print("v[%d]->r[%d]\n",i,i+ul->nr+1);
68    l->m[i+ul->nr+1].rtyp=vl->m[i].rtyp;
69    l->m[i+ul->nr+1].data=vl->m[i].data;
70  }
71  if (ul->m != NULL)
72    omFreeSize((ADDRESS)ul->m,(ul->nr+1)*sizeof(sleftv));
73  omFreeBin((ADDRESS)ul, slists_bin);
74  if (vl->m != NULL)
75    omFreeSize((ADDRESS)vl->m,(vl->nr+1)*sizeof(sleftv));
76  omFreeBin((ADDRESS)vl, slists_bin);
77  memset(u,0,sizeof(*u));
78  memset(v,0,sizeof(*v));
79  res->data = (char *)l;
80  //res->Print();
81  return FALSE;
82}
83
84/*2
85* insert v into list ul, destroys u
86*/
87lists lInsert0(lists ul, leftv v, int pos)
88{
89  if ((pos<0)||(v->rtyp==NONE))
90    return NULL;
91  lists l=(lists) omAllocBin(slists_bin);
92  l->Init(si_max(ul->nr+2,pos+1));
93  int i,j;
94
95  for(i=j=0;i<=ul->nr;i++,j++)
96  {
97    if(j==pos) j++;
98    l->m[j]=ul->m[i];
99  }
100  for(j=ul->nr+1;j<pos;j++)
101    l->m[j].rtyp=DEF_CMD;
102  // memset(&(l->m[pos]),0,sizeof(sleftv)); - done by Init
103  l->m[pos].rtyp=v->Typ();
104  l->m[pos].data=v->CopyD();
105  l->m[pos].flag=v->flag;
106  attr *a=v->Attribute();
107  if ((a!=NULL)&&(*a!=NULL))
108  {
109    l->m[pos].attribute=(*a)->Copy();
110  }
111  if (ul->m != NULL)
112    omFreeSize((ADDRESS)ul->m,(ul->nr+1)*sizeof(sleftv));
113  omFreeBin((ADDRESS)ul, slists_bin);
114  return l;
115}
116
117/*2
118* insert v into list u, at the beginning
119*/
120BOOLEAN lInsert(leftv res, leftv u, leftv v)
121{
122  lists ul=(lists)u->CopyD();
123  res->data=(char *)lInsert0(ul,v,0);
124  if (res->data==NULL)
125  {
126    Werror("cannot insert type `%s`",Tok2Cmdname(v->Typ()));
127    return TRUE;
128  }
129  return FALSE;
130}
131
132/*2
133* insert v into list u at pos w
134*/
135BOOLEAN lInsert3(leftv res, leftv u, leftv v, leftv w)
136{
137  lists ul=(lists)u->CopyD();
138  res->data=(char *)lInsert0(ul,v,(int)(long)w->Data());
139  if (res->data==NULL)
140  {
141    Werror("cannot insert type `%s` at pos. %d",
142      Tok2Cmdname(v->Typ()),(int)(long)w->Data());
143    return TRUE;
144  }
145  return FALSE;
146}
147
148/*2
149* append v to list u
150*/
151BOOLEAN lAppend(leftv res, leftv u, leftv v)
152{
153  lists ul=(lists)u->CopyD();
154  res->data=(char *)lInsert0(ul,v,ul->nr+1);
155  return (res->data==NULL);
156}
157
158/*2
159* delete v-th element from list u
160*/
161BOOLEAN lDelete(leftv res, leftv u, leftv v)
162{
163  lists ul=(lists)u->Data();
164  int VIndex=(int)(long)v->Data()-1;
165  int EndIndex=lSize(ul);
166
167  if((0<=VIndex)&&(VIndex<=ul->nr))
168  {
169    ul=(lists)u->CopyD();
170    int i,j;
171    lists l=(lists) omAllocBin(slists_bin);
172    l->Init(EndIndex+(VIndex>EndIndex));
173
174    for(i=j=0;i<=EndIndex;i++,j++)
175    {
176      if (i!=VIndex)
177      {
178        l->m[j]=ul->m[i];
179        memset(&ul->m[i],0,sizeof(ul->m[i]));
180      }
181      else
182      {
183        j--;
184        ul->m[i].CleanUp();
185      }
186    }
187    omFreeSize((ADDRESS)ul->m,(ul->nr+1)*sizeof(sleftv));
188    omFreeBin((ADDRESS)ul, slists_bin);
189    res->data = (char *)l;
190    return FALSE;
191  }
192  Werror("wrong index %d in list(%d)",VIndex+1,ul->nr+1);
193  return TRUE;
194}
195
196/*2
197* check, if a list contains any ring dependend data
198*/
199BOOLEAN lRingDependend(lists L)
200{
201  if (L==NULL) return FALSE;
202  int i=0;
203  while (i<=L->nr)
204  {
205    if ((BEGIN_RING<L->m[i].rtyp)
206    && (L->m[i].rtyp<END_RING))
207      return TRUE;
208    if ((L->m[i].rtyp==LIST_CMD)&&lRingDependend((lists)L->m[i].data))
209      return TRUE;
210    i++;
211  }
212  return FALSE;
213}
214
215lists liMakeResolv(resolvente r, int length, int reallen,
216  int typ0, intvec ** weights, int add_row_shift)
217{
218  // re-uses r, weights[i]
219  lists L=(lists)omAlloc0Bin(slists_bin);
220  if (length<=0)
221  {
222    // handle "empty" resolutions
223    L->Init(0);
224  }
225  else
226  {
227    int oldlength=length;
228    while (r[length-1]==NULL) length--;
229    if (reallen<=0) reallen=currRing->N;
230    reallen=si_max(reallen,length);
231    L->Init(reallen);
232    int i=0;
233
234    while (i<length)
235    {
236      if (r[i]!=NULL)
237      {
238        if (i==0)
239        {
240          L->m[i].rtyp=typ0;
241          int j=IDELEMS(r[0])-1;
242          while ((j>0) && (r[0]->m[j]==NULL)) j--;
243          j++;
244          if (j!=IDELEMS(r[0]))
245          {
246            pEnlargeSet(&(r[0]->m),IDELEMS(r[0]),j-IDELEMS(r[0]));
247            IDELEMS(r[0])=j;
248          }
249        }
250        else
251        {
252          L->m[i].rtyp=MODUL_CMD;
253          int rank=IDELEMS(r[i-1]);
254          if (idIs0(r[i-1]))
255          {
256            idDelete(&(r[i]));
257            r[i]=id_FreeModule(rank, currRing);
258          }
259          else
260          {
261            r[i]->rank=si_max(rank,(int)id_RankFreeModule(r[i], currRing));
262          }
263          idSkipZeroes(r[i]);
264        }
265        L->m[i].data=(void *)r[i];
266        if ((weights!=NULL) && (weights[i]!=NULL))
267        {
268          intvec *w=weights[i];
269          (*w) += add_row_shift;
270          atSet((idhdl)&L->m[i],omStrDup("isHomog"),w,INTVEC_CMD);
271          weights[i] = NULL;
272        }
273      }
274      #ifdef TEST
275      else
276      {
277        // should not happen:
278        WarnS("internal NULL in resolvente");
279        L->m[i].data=(void *)idInit(1,1);
280      }
281      #endif
282      i++;
283    }
284    omFreeSize((ADDRESS)r,oldlength*sizeof(ideal));
285    if (weights!=NULL) omFreeSize(weights,oldlength*sizeof(intvec*));
286    if (i==0)
287    {
288      L->m[0].rtyp=typ0;
289      L->m[0].data=(char *)idInit(1,1);
290      i=1;
291    }
292    while (i<reallen)
293    {
294      L->m[i].rtyp=MODUL_CMD;
295      ideal I=(ideal)L->m[i-1].data;
296      ideal J;
297      int rank=IDELEMS(I);
298      if (idIs0(I))
299      {
300        J=idFreeModule(rank);
301      }
302      else
303      {
304        J=idInit(1,rank);
305      }
306      L->m[i].data=(void *)J;
307      i++;
308    }
309    //Print("make res of length %d (0..%d) L:%d\n",length,length-1,L->nr);
310  }
311  return L;
312}
313
314resolvente liFindRes(lists L, int * len, int *typ0,intvec *** weights)
315{
316  resolvente r;
317  intvec ** w=NULL,*tw=NULL;
318
319  *len=L->nr+1;
320  if (*len<=0)
321  {
322    WerrorS("empty list");
323    return NULL;
324  }
325  r=(ideal *)omAlloc0((*len)*sizeof(ideal));
326  w=(intvec**)omAlloc0((*len)*sizeof(intvec*));
327  int i=0;
328  *typ0=MODUL_CMD;
329  while (i<(*len))
330  {
331    if (L->m[i].rtyp != MODUL_CMD)
332    {
333      if (L->m[i].rtyp!=IDEAL_CMD)
334      {
335        Werror("element %d is not of type module",i+1);
336        omFreeSize((ADDRESS)r,(*len)*sizeof(ideal));
337        return NULL;
338      }
339      *typ0=IDEAL_CMD;
340    }
341    if ((i>0) && (idIs0(r[i-1])))
342    {
343      //*len=i-1;
344      break;
345    }
346    r[i]=(ideal)L->m[i].data;
347    tw=(intvec*)atGet(&(L->m[i]),"isHomog",INTVEC_CMD);
348    if (tw!=NULL)
349    {
350      w[i]=ivCopy(tw);
351    }
352    tw = NULL;
353    i++;
354  }
355  BOOLEAN hom_complex=TRUE;
356  int j=0;
357  while ((j<i) && hom_complex)
358  {
359    hom_complex = hom_complex && (w[j]!=NULL);
360    j++;
361  }
362  if ((!hom_complex) || (weights==NULL))
363  {
364    for (j=0;j<i;j++)
365    {
366      if (w[j]!=NULL) delete w[j];
367    }
368    omFreeSize((ADDRESS)w,(*len)*sizeof(intvec*));
369    if (weights!=NULL) *weights=NULL;
370  }
371  else
372  {
373    *weights = w;
374  }
375  //Print("find res of length %d (0..%d) L:%d\n",*len,(*len)-1,L->nr);
376  return r;
377}
378
379char* lString(lists l, BOOLEAN typed, int dim)
380{
381  if (l->nr == -1)
382  {
383    if (typed) return omStrDup("list()");
384    return omStrDup("");
385  }
386
387  char** slist = (char**) omAlloc((l->nr+1) * sizeof(char*));
388  int i, j, k;
389  char *s;
390  for (i=0, j = 0, k = 0; i<=l->nr; i++)
391  {
392    slist[i] = l->m[i].String(NULL, typed, dim);
393    assume(slist[i] != NULL);
394    omCheckAddr(slist[i]);
395    if (*(slist[i]) != '\0')
396    {
397      j += strlen(slist[i]);
398      k++;
399    }
400  }
401  s = (char*) omAlloc(j+k+2+(typed ? 10 : 0) + (dim == 2 ? k : 0));
402
403  if (typed)
404    sprintf(s, "list(");
405  else
406    *s = '\0';
407
408  for (i=0; i<=l->nr; i++)
409  {
410    if (*(slist[i]) != '\0')
411    {
412      strcat(s, slist[i]);
413      strcat(s, ",");
414      if (dim == 2) strcat(s, "\n");
415    }
416    omCheckAddr(s);
417    omFree(slist[i]);
418  }
419  if (k > 0) s[strlen(s) - (dim == 2 ? 2 : 1)] = '\0';
420  if (typed) strcat(s, ")");
421  omCheckAddr(s);
422  omFreeSize(slist, (l->nr+1) * sizeof(char*));
423  return s;
424}
Note: See TracBrowser for help on using the repository browser.