source: git/modules/pcv.mod @ 2dc9fea

fieker-DuValspielwiese
Last change on this file since 2dc9fea was d2a9631, checked in by Anne Frühbis-Krüger <anne@…>, 21 years ago
*** empty log message *** git-svn-id: file:///usr/local/Singular/svn/trunk@6793 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 10.4 KB
Line 
1%{
2/*
3 *  $Id: pcv.mod,v 1.2 2003-06-11 10:21:28 anne Exp $
4 *
5 *  Test mod fuer modgen
6 */
7
8#include <stdio.h>
9#include <mod2.h>
10#include <tok.h>
11#include <ipid.h>
12#include <numbers.h>
13#include <polys.h>
14#include <ideals.h>
15#include <lists.h>
16#include <matpol.h>
17#include <febase.h>
18
19static int pcvMaxDegree;
20static int pcvTableSize;
21static int pcvIndexSize;
22static unsigned* pcvTable=NULL;
23static unsigned** pcvIndex=NULL;
24
25#ifndef PCV_H
26#define PCV_H
27
28lists pcvLAddL(lists l1,lists l2);
29lists pcvPMulL(poly p,lists l1);
30BOOLEAN pcvLAddL(leftv res,leftv h);
31BOOLEAN pcvPMulL(leftv res,leftv h);
32int pcvDeg(poly p);
33int pcvMinDeg(poly p);
34int pcvMinDeg(matrix m);
35BOOLEAN pcvMinDeg(leftv res,leftv h);
36void pcvInit(int d);
37void pcvClean();
38int pcvM2N(poly m);
39poly pcvN2M(int n);
40poly pcvP2CV(poly p,int d0,int d1);
41poly pcvCV2P(poly cv,int d0,int d1);
42lists pcvP2CV(lists pl,int d0,int d1);
43ideal pcvP2CV(ideal p,int d0,int d1);
44lists pcvCV2P(lists cvl,int d0,int d1);
45ideal pcvCV2P(ideal cv,int d0,int d1);
46BOOLEAN pcvP2CV(leftv res,leftv h);
47BOOLEAN pcvCV2P(leftv res,leftv h);
48int pcvDim(int d0,int d1);
49BOOLEAN pcvDim(leftv res,leftv h);
50int pcvBasis(lists b,int i,poly m,int d,int n);
51lists pcvBasis(int d0,int d1);
52BOOLEAN pcvBasis(leftv res,leftv h);
53
54#endif
55%}
56
57
58// module="pcv";
59package="pcv";
60
61version="$Id: pcv.mod,v 1.2 2003-06-11 10:21:28 anne Exp $";
62info="
63LIBRARY: pcv.so  CONVERSION BETWEEN POLYS AND COEF VECTORS
64AUTHOR:  Mathias Schulze, email: mschulze@mathematik.uni-kl.de
65
66 MinDeg(p);      min deg of monomials of poly p
67 P2CV(l,d0,d1);  list of coef vectors from deg d0 to d1 of polys in list l
68 CV2P(l,d0,d1);  list of polys with coef vectors from deg d0 to d1 in list l
69 Dim(d0,d1);     number of monomials from deg d0 to d1
70 Basis(d0,d1);   list of monomials from deg d0 to d1
71";
72
73%modinitial
74// no commands to be run upon loading the module
75%endinitial
76
77%procedures
78
79
80int MinDeg(poly p) {
81   %declaration;
82   %typecheck;
83   %return(pcvMinDeg(p));
84}
85
86list P2CV(list pl,int d0,int d1) {
87  %declaration;
88
89  /* check if current RingHandle is set */
90  if(currRingHdl == NULL)
91  {
92    WerrorS("no ring active");
93    return TRUE;
94  }
95 
96  %typecheck;
97  %return(pcvP2CV(pl, d0, d1));
98}
99
100list CV2P(list pl,int d0,int d1)
101{
102  %declaration;
103
104  /* check if current RingHandle is set */
105  if(currRingHdl == NULL)
106  {
107    WerrorS("no ring active");
108    return TRUE;
109  }
110 
111  %typecheck;
112  %return(pcvCV2P(pl, d0, d1));
113}
114
115int Dim(int d0,int d1)
116{
117  %declaration;
118
119  /* check if current RingHandle is set */
120  if(currRingHdl == NULL)
121  {
122    WerrorS("no ring active");
123    return TRUE;
124  }
125 
126  %typecheck;
127  %return(pcvDim);
128}
129
130list Basis(int d0,int d1)
131{
132  %declaration;
133
134  /* check if current RingHandle is set */
135  if(currRingHdl == NULL)
136  {
137    WerrorS("no ring active");
138    return TRUE;
139  }
140 
141  %typecheck;
142  %return(pcvBasis);
143}
144
145%C
146lists pcvLAddL(lists l1,lists l2)
147{
148  lists l0=(lists)omAllocBin(slists_bin);
149  int i=l1->nr;
150  if(l1->nr<l2->nr) i=l2->nr;
151  l0->Init(i+1);
152  for(;i>=0;i--)
153  {
154    if(i<=l1->nr&&(l1->m[i].rtyp==POLY_CMD||l1->m[i].rtyp==VECTOR_CMD))
155    {
156      l0->m[i].rtyp=l1->m[i].rtyp;
157      l0->m[i].data=pCopy((poly)l1->m[i].data);
158      if(i<=l2->nr&&l2->m[i].rtyp==l1->m[i].rtyp)
159        l0->m[i].data=pAdd((poly)l0->m[i].data,pCopy((poly)l2->m[i].data));
160    }
161    else
162    if(i<=l2->nr&&(l2->m[i].rtyp==POLY_CMD||l2->m[i].rtyp==VECTOR_CMD))
163    {
164      l0->m[i].rtyp=l2->m[i].rtyp;
165      l0->m[i].data=pCopy((poly)l2->m[i].data);
166    }
167  }
168  return(l0);
169}
170
171lists pcvPMulL(poly p,lists l1)
172{
173  lists l0=(lists)omAllocBin(slists_bin);
174  l0->Init(l1->nr+1);
175  for(int i=l1->nr;i>=0;i--)
176  {
177    if(l1->m[i].rtyp==POLY_CMD)
178    {
179      l0->m[i].rtyp=POLY_CMD;
180      l0->m[i].data=ppMult_qq(p,(poly)l1->m[i].data);
181    }
182  }
183  return(l0);
184}
185
186BOOLEAN pcvLAddL(leftv res,leftv h)
187{
188  if(h&&h->Typ()==LIST_CMD)
189  {
190    lists l1=(lists)h->Data();
191    h=h->next;
192    if(h&&h->Typ()==LIST_CMD)
193    {
194      lists l2=(lists)h->Data();
195      res->rtyp=LIST_CMD;
196      res->data=(void*)pcvLAddL(l1,l2);
197      return FALSE;
198    }
199  }
200  WerrorS("<list>,<list> expected");
201  return TRUE;
202}
203
204BOOLEAN pcvPMulL(leftv res,leftv h)
205{
206  if(h&&h->Typ()==POLY_CMD)
207  {
208    poly p=(poly)h->Data();
209    h=h->next;
210    if(h&&h->Typ()==LIST_CMD)
211    {
212      lists l=(lists)h->Data();
213      res->rtyp=LIST_CMD;
214      res->data=(void*)pcvPMulL(p,l);
215      return FALSE;
216    }
217  }
218  WerrorS("<poly>,<list> expected");
219  return TRUE;
220}
221
222int pcvDeg(poly p)
223{
224  int d=0;
225  for(int i=pVariables;i>=1;i--) d+=pGetExp(p,i);
226  return d;
227}
228
229int pcvMinDeg(poly p)
230{
231  if(!p) return -1;
232  int md=pcvDeg(p);
233  pIter(p);
234  while(p)
235  {
236    int d=pcvDeg(p);
237    if(d<md) md=d;
238    pIter(p);
239  }
240  return md;
241}
242
243int pcvMinDeg(matrix m)
244{
245  int i,j,d;
246  int md=-1;
247  for(i=1;i<=MATROWS(m);i++)
248  {
249    for(j=1;j<=MATCOLS(m);j++)
250    {
251      d=pcvMinDeg(MATELEM(m,i,j));
252      if((d>=0&&md>d)||md==-1) md=d;
253    }
254  }
255  return(md);
256}
257
258BOOLEAN pcvMinDeg(leftv res,leftv h)
259{
260  if(h)
261  {
262    if(h->Typ()==POLY_CMD)
263    {
264      res->rtyp=INT_CMD;
265      res->data=(void*)pcvMinDeg((poly)h->Data());
266      return FALSE;
267    }
268    else
269    if(h->Typ()==MATRIX_CMD)
270    {
271      res->rtyp=INT_CMD;
272      res->data=(void*)pcvMinDeg((matrix)h->Data());
273      return FALSE;
274    }
275  }
276  WerrorS("<poly> expected");
277  return TRUE;
278}
279
280void pcvInit(int d)
281{
282  if(d<0) d=1;
283  pcvMaxDegree=d+1;
284  pcvTableSize=pVariables*pcvMaxDegree*sizeof(unsigned);
285  pcvTable=(unsigned*)omAlloc0(pcvTableSize);
286  pcvIndexSize=pVariables*sizeof(unsigned*);
287  pcvIndex=(unsigned**)omAlloc(pcvIndexSize);
288  for(int i=0;i<pVariables;i++)
289    pcvIndex[i]=pcvTable+i*pcvMaxDegree;
290  for(int i=0;i<pcvMaxDegree;i++)
291    pcvIndex[0][i]=i;
292  unsigned k,l;
293  for(int i=1;i<pVariables;i++)
294  {
295    k=0;
296    for(int j=0;j<pcvMaxDegree;j++)
297    {
298      l=pcvIndex[i-1][j];
299      if(l>unsigned(~0)-k)
300      {
301        j=pcvMaxDegree;
302        i=pVariables;
303        WerrorS("unsigned overflow");
304      }
305      else pcvIndex[i][j]=k+=l;
306    }
307  }
308}
309
310void pcvClean()
311{
312  if(pcvTable)
313  {
314    omFreeSize(pcvTable,pcvTableSize);
315    pcvTable=NULL;
316  }
317  if(pcvIndex)
318  {
319    omFreeSize(pcvIndex,pcvIndexSize);
320    pcvIndex=NULL;
321  }
322}
323
324int pcvM2N(poly m)
325{
326  unsigned n=0,dn,d=0;
327  for(int i=0;i<pVariables;i++)
328  {
329    d+=pGetExp(m,i+1);
330    dn=pcvIndex[i][d];
331    if(dn>MAX_COMPONENT-n)
332    {
333      i=pVariables;
334      WerrorS("component overflow");
335    }
336    else n+=dn;
337  }
338  return n+1;
339}
340
341poly pcvN2M(int n)
342{
343  n--;
344  poly m=pOne();
345  int i,j,k;
346  for(i=pVariables-1;i>=0;i--)
347  {
348    k=j;
349    for(j=0; (j<pcvMaxDegree) && (pcvIndex[i][j]<=(unsigned)n); j++);
350    j--;
351    n-=pcvIndex[i][j];
352    if(i<pVariables-1) pSetExp(m,i+2,k-j);
353  }
354  if(n==0)
355  {
356    pSetExp(m,1,j);
357    pSetm(m);
358    return m;
359  }
360  else
361  {
362    pDeleteLm(&m);
363    return NULL;
364  }
365}
366
367poly pcvP2CV(poly p,int d0,int d1)
368{
369  poly cv=NULL;
370  while(p)
371  {
372    int d=pcvDeg(p);
373    if(d0<=d&&d<d1)
374    {
375      poly c=pNSet(nCopy(pGetCoeff(p)));
376      pSetComp(c,pcvM2N(p));
377      cv=pAdd(cv,c);
378    }
379    pIter(p);
380  }
381  return cv;
382}
383
384poly pcvCV2P(poly cv,int d0,int d1)
385{
386  poly p=NULL;
387  while(cv)
388  {
389    poly m=pcvN2M(pGetComp(cv));
390    if(m)
391    {
392      int d=pcvDeg(m);
393      if(d0<=d&&d<d1)
394      {
395        pSetCoeff(m,nCopy(pGetCoeff(cv)));
396        p=pAdd(p,m);
397      }
398    }
399    pIter(cv);
400  }
401  return p;
402}
403
404lists pcvP2CV(lists pl,int d0,int d1)
405{
406  lists cvl=(lists)omAllocBin(slists_bin);
407  cvl->Init(pl->nr+1);
408  pcvInit(d1);
409  for(int i=pl->nr;i>=0;i--)
410  {
411    if(pl->m[i].rtyp==POLY_CMD)
412    {
413      cvl->m[i].rtyp=VECTOR_CMD;
414      cvl->m[i].data=pcvP2CV((poly)pl->m[i].data,d0,d1);
415    }
416  }
417  pcvClean();
418  return cvl;
419}
420
421lists pcvCV2P(lists cvl,int d0,int d1)
422{
423  lists pl=(lists)omAllocBin(slists_bin);
424  pl->Init(cvl->nr+1);
425  pcvInit(d1);
426  for(int i=cvl->nr;i>=0;i--)
427  {
428    if(cvl->m[i].rtyp==VECTOR_CMD)
429    {
430      pl->m[i].rtyp=POLY_CMD;
431      pl->m[i].data=pcvCV2P((poly)cvl->m[i].data,d0,d1);
432    }
433  }
434  pcvClean();
435  return pl;
436}
437
438BOOLEAN pcvP2CV(leftv res,leftv h)
439{
440  if(currRingHdl)
441  {
442    if(h&&h->Typ()==LIST_CMD)
443    {
444      lists p=(lists)h->Data();
445      h=h->next;
446      if(h&&h->Typ()==INT_CMD)
447      {
448        int d0=(int)h->Data();
449        h=h->next;
450        if(h&&h->Typ()==INT_CMD)
451        {
452          int d1=(int)h->Data();
453          res->rtyp=LIST_CMD;
454          res->data=(void*)pcvP2CV(p,d0,d1);
455          return FALSE;
456        }
457      }
458    }
459    WerrorS("<list>,<int>,<int> expected");
460    return TRUE;
461  }
462  WerrorS("no ring active");
463  return TRUE;
464}
465
466BOOLEAN pcvCV2P(leftv res,leftv h)
467{
468  if(currRingHdl)
469  {
470    if(h&&h->Typ()==LIST_CMD)
471    {
472      lists pl=(lists)h->Data();
473      h=h->next;
474      if(h&&h->Typ()==INT_CMD)
475      {
476        int d0=(int)h->Data();
477        h=h->next;
478        if(h&&h->Typ()==INT_CMD)
479        {
480          int d1=(int)h->Data();
481          res->rtyp=LIST_CMD;
482          res->data=(void*)pcvCV2P(pl,d0,d1);
483          return FALSE;
484        }
485      }
486    }
487    WerrorS("<list>,<int>,<int> expected");
488    return TRUE;
489  }
490  WerrorS("no ring active");
491  return TRUE;
492}
493
494int pcvDim(int d0,int d1)
495{
496  if(d0<0) d0=0;
497  if(d1<0) d1=0;
498  pcvInit(d1);
499  int d=pcvIndex[pVariables-1][d1]-pcvIndex[pVariables-1][d0];
500  pcvClean();
501  return d;
502}
503
504BOOLEAN pcvDim(leftv res,leftv h)
505{
506  if(currRingHdl)
507  {
508    if(h&&h->Typ()==INT_CMD)
509    {
510      int d0=(int)h->Data();
511      h=h->next;
512      if(h&&h->Typ()==INT_CMD)
513      {
514        int d1=(int)h->Data();
515        res->rtyp=INT_CMD;
516        res->data=(void*)pcvDim(d0,d1);
517        return FALSE;
518      }
519    }
520    WerrorS("<int>,<int> expected");
521    return TRUE;
522  }
523  WerrorS("no ring active");
524  return TRUE;
525}
526
527int pcvBasis(lists b,int i,poly m,int d,int n)
528{
529  if(n<pVariables)
530  {
531    for(int k=0,l=d;k<=l;k++,d--)
532    {
533      pSetExp(m,n,k);
534      i=pcvBasis(b,i,m,d,n+1);
535    }
536  }
537  else
538  {
539    pSetExp(m,n,d);
540    pSetm(m);
541    b->m[i].rtyp=POLY_CMD;
542    b->m[i++].data=pCopy(m);
543  }
544  return i;
545}
546
547lists pcvBasis(int d0,int d1)
548{
549  if(d0<0) d0=0;
550  if(d1<0) d1=0;
551  lists b=(lists)omAllocBin(slists_bin);
552  b->Init(pcvDim(d0,d1));
553  poly m=pOne();
554  for(int d=d0,i=0;d<d1;d++)
555    i=pcvBasis(b,i,m,d,1);
556  pDeleteLm(&m);
557  return b;
558}
559
560BOOLEAN pcvBasis(leftv res,leftv h)
561{
562  if(currRingHdl)
563  {
564    if(h&&h->Typ()==INT_CMD)
565    {
566      int d0=(int)h->Data();
567      h=h->next;
568      if(h&&h->Typ()==INT_CMD)
569      {
570        int d1=(int)h->Data();
571        res->rtyp=LIST_CMD;
572        res->data=(void*)pcvBasis(d0,d1);
573        return FALSE;
574      }
575    }
576    WerrorS("<int>,<int> expected");
577    return TRUE;
578  }
579  WerrorS("no ring active");
580  return TRUE;
581}
Note: See TracBrowser for help on using the repository browser.