source: git/Singular/lists.cc @ 0fb34ba

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