OpenXM/src/kan96xx/Kan/kanExport1.c - diff

Return to kanExport1.c CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/kanExport1.c between version 1.5 and 1.7

-version 1.5, 2003/07/17 07:33:03
+version 1.7, 2003/08/22 11:47:03
 Line 1
 Line 1
 Line 1
- /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.4 2003/07/13 07:53:17 takayama Exp $ */
+ /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.6 2003/08/21 12:28:57 takayama Exp $ */
  #include <stdio.h>
  #include "datatype.h"
  #include "stackm.h"
 Line 43  struct object Kreduction(f,set)
 Line 43  struct object Kreduction(f,set)
 Line 43  struct object Kreduction(f,set)
    }else{
      r = (*reduction)(f.lc.poly,grG,1,&syz);
    }
+   /* outputGradedPolySet(grG,0); */
    if (flag) {
      rob = newObjectArray(3);
      putoa(rob,0,KpoPOLY(r));
-Line 500  struct object syzPolyToArray(size,f,grG)
+Line 501  struct object syzPolyToArray(size,f,grG)
 Line 500  struct object syzPolyToArray(size,f,grG)
 Line 501  struct object syzPolyToArray(size,f,grG)
    while (f != POLYNULL) {
      g0 = srGrade(f);
      i0 = srIndex(f);
      serial = grG->polys[g0]->serial[i0];
      if (serial < 0) {
        errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");
-Line 923  struct object oInitW(ob,oWeight)
+Line 924  struct object oInitW(ob,oWeight)
 Line 923  struct object oInitW(ob,oWeight)
 Line 924  struct object oInitW(ob,oWeight)
    int w[2*N0];
    int n,i;
    struct object ow;
+   int shiftvec;
+   struct object oShift;
+   int *s;
+   int ssize,m;
+   shiftvec = 0;
+   s = NULL;
    if (oWeight.tag != Sarray) {
      errorKan1("%s\n","oInitW(): the second argument must be array.");
    }
    n = getoaSize(oWeight);
+   if (n == 0)  errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
+   if (getoa(oWeight,0).tag == Sarray) {
+         if (n != 2) errorKan1("%s\n","oInitW(): the size of the second argument should be 2.");
+         shiftvec = 1;
+         oShift = getoa(oWeight,1);
+         oWeight = getoa(oWeight,0);
+         if (oWeight.tag != Sarray) {
+           errorKan1("%s\n","oInitW(): the weight vector must be array.");
+         }
+         n = getoaSize(oWeight);
+         if (oShift.tag != Sarray) {
+           errorKan1("%s\n","oInitW(): the shift vector must be array.");
+         }
+   }
+   /* oWeight = Ksm1WeightExpressionToVec(oWeight); */
    if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
    for (i=0; i<n; i++) {
      ow = getoa(oWeight,i);
+         if (ow.tag == SuniversalNumber) {
+           ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
+         }
      if (ow.tag != Sinteger) {
        errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");
      }
      w[i] = KopInteger(ow);
    }
+   if (shiftvec) {
+     ssize = getoaSize(oShift);
+         s = (int *)sGC_malloc(sizeof(int)*(ssize+1));
+         if (s == NULL) errorKan1("%s\n","oInitW() no more memory.");
+         for (i=0; i<ssize; i++) {
+           ow = getoa(oShift,i);
+           if (ow.tag == SuniversalNumber) {
+                 ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
+           }
+           if (ow.tag != Sinteger) {
+                 errorKan1("%s\n","oInitW(): the entries of shift vector must be integers.");
+           }
+           s[i] = KopInteger(ow);
+         }
+   }
    switch(ob.tag) {
    case Spoly:
      f = KopPOLY(ob);
-     return( KpoPOLY(POLYToInitW(f,w)));
+         if (shiftvec) {
+           return( KpoPOLY(POLYToInitWS(f,w,s)));
+         }else{
+           return( KpoPOLY(POLYToInitW(f,w)));
+         }
      break;
+   case Sarray:
+         m = getoaSize(ob);
+         f = objArrayToPOLY(ob);
+     /* printf("1.%s\n",POLYToString(f,'*',1)); */
+         if (shiftvec) {
+           f =  POLYToInitWS(f,w,s);
+         }else{
+           f =  POLYToInitW(f,w);
+         }
+     /* printf("2.%s\n",POLYToString(f,'*',1)); */
+         return POLYtoObjArray(f,m);
    default:
-     errorKan1("%s\n","oInitW(): Argument must be polynomial.");
+     errorKan1("%s\n","oInitW(): Argument must be polynomial or a vector of polynomials");
      break;
    }
  }
+ POLY objArrayToPOLY(struct object ob) {
+   int m;
+   POLY f;
+   POLY t;
+   int i,n;
+   struct ring *ringp;
+   if (ob.tag != Sarray) errorKan1("%s\n", "objArrayToPOLY() the argument must be an array.");
+   m = getoaSize(ob);
+   ringp = NULL;
+   f = POLYNULL;
+   for (i=0; i<m; i++) {
+     if (getoa(ob,i).tag != Spoly) errorKan1("%s\n","objArrayToPOLY() elements must be a polynomial.");
+     t = KopPOLY(getoa(ob,i));
+     if (t ISZERO) {
+     }else{
+       if (ringp == NULL) {
+         ringp = t->m->ringp;
+         n = ringp->n;
+       }
+       t = (*mpMult)(cxx(1,n-1,i,ringp),t);
+       f = ppAddv(f,t);
+     }
+   }
+   return f;
+ }
+ struct object POLYtoObjArray(POLY f,int size) {
+   struct object rob;
+   POLY *pa;
+   int d,n,i;
+   POLY t;
+   if (size < 0) errorKan1("%s\n","POLYtoObjArray() invalid size.");
+   rob = newObjectArray(size);
+   pa = (POLY *) sGC_malloc(sizeof(POLY)*(size+1));
+   if (pa == NULL) errorKan1("%s\n","POLYtoObjArray() no more memory.");
+   for (i=0; i<size; i++) {
+     pa[i] = POLYNULL;
+     putoa(rob,i,KpoPOLY(pa[i]));
+   }
+   if (f == POLYNULL) {
+     return rob;
+   }
+   n = f->m->ringp->n;
+   while (f != POLYNULL) {
+     d = f->m->e[n-1].x;
+     if (d >= size) errorKan1("%s\n","POLYtoObjArray() size is too small.");
+     t = newCell(f->coeffp,monomialCopy(f->m));
+         i = t->m->e[n-1].x;
+     t->m->e[n-1].x = 0;
+     pa[i] = ppAddv(pa[i],t); /* slow to add from the top. */
+     f = f->next;
+   }
+   for (i=0; i<size; i++) {
+     putoa(rob,i,KpoPOLY(pa[i]));
+   }
+   return rob;
+ }
  int KpolyLength(POLY f) {
    int size;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>