[BACK]Return to kanExport1.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/kanExport1.c between version 1.2 and 1.8

version 1.2, 2001/05/04 01:06:24 version 1.8, 2003/08/23 02:28:38
Line 1 
Line 1 
   /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.7 2003/08/22 11:47:03 takayama Exp $ */
 #include <stdio.h>  #include <stdio.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
Line 11 
Line 12 
 static int Message = 1;  static int Message = 1;
 extern int KanGBmessage;  extern int KanGBmessage;
   
   struct object DegreeShifto;
   int DegreeShifto_size = 0;
   int *DegreeShifto_vec = NULL;
   
 /** :kan, :ring */  /** :kan, :ring */
 struct object Kreduction(f,set)  struct object Kreduction(f,set)
      struct object f;       struct object f;
Line 38  struct object Kreduction(f,set)
Line 43  struct object Kreduction(f,set)
   }else{    }else{
     r = (*reduction)(f.lc.poly,grG,1,&syz);      r = (*reduction)(f.lc.poly,grG,1,&syz);
   }    }
     /* outputGradedPolySet(grG,0); */
   if (flag) {    if (flag) {
     rob = newObjectArray(3);      rob = newObjectArray(3);
     putoa(rob,0,KpoPOLY(r));      putoa(rob,0,KpoPOLY(r));
Line 495  struct object syzPolyToArray(size,f,grG)
Line 501  struct object syzPolyToArray(size,f,grG)
   
   while (f != POLYNULL) {    while (f != POLYNULL) {
     g0 = srGrade(f);      g0 = srGrade(f);
     i0 = srIndex(f);      i0 = srIndex(f);
     serial = grG->polys[g0]->serial[i0];      serial = grG->polys[g0]->serial[i0];
     if (serial < 0) {      if (serial < 0) {
       errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");        errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");
Line 683  struct object homogenizeObject(ob,gradep)
Line 689  struct object homogenizeObject(ob,gradep)
     rob = newObjectArray(size);      rob = newObjectArray(size);
     flag = 0;      flag = 0;
     ob1 = getoa(ob,0);      ob1 = getoa(ob,0);
       if (ob1.tag == Sdollar) return(homogenizeObject_go(ob,gradep));
     ob1 = homogenizeObject(ob1,&gr);      ob1 = homogenizeObject(ob1,&gr);
     maxg = gr;      maxg = gr;
     getoa(rob,0) = ob1;      getoa(rob,0) = ob1;
Line 744  struct object homogenizeObject_vec(ob,gradep)
Line 751  struct object homogenizeObject_vec(ob,gradep)
     if (size == 0) {      if (size == 0) {
       errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");        errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");
     }      }
       if (getoa(ob,0).tag == Sdollar) return(homogenizeObject_go(ob,gradep));
     rob = newObjectArray(size);      rob = newObjectArray(size);
     for (i=0; i<size; i++) {      for (i=0; i<size; i++) {
       ob1 = getoa(ob,i);        ob1 = getoa(ob,i);
Line 763  struct object homogenizeObject_vec(ob,gradep)
Line 771  struct object homogenizeObject_vec(ob,gradep)
   }    }
 }  }
   
   struct object homogenizeObject_go(struct object ob,int *gradep) {
     int size,i,dssize,j;
     struct object ob0;
     struct object ob1;
     struct object ob2;
     struct object rob;
     struct object tob;
     struct object ob1t;
     int *ds;
     POLY f;
     rob = NullObject;
     if (ob.tag != Sarray) errorKan1("%s\n","homogenizeObject_go(): Invalid argument data type.");
   
     size = getoaSize(ob);
     if (size == 0) errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
     ob0 = getoa(ob,0);
     if (ob0.tag != Sdollar) {
       errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
     }
     if (strcmp(KopString(ob0),"degreeShift") == 0) {
       if (size < 2)
         errorKan1("%s\n","homogenizeObject_go(): [(degreeShift) shift-vector obj] or [(degreeShift) shift-vector] or [(degreeShift) (value)] homogenize");
       ob1 = getoa(ob,1);
           if (ob1.tag != Sarray) {
             if (DegreeShifto_size != 0) {
                   return DegreeShifto;
             }else{
           rob = NullObject;
           return rob;
             }
           }
       dssize = getoaSize(ob1);
       ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
       for (i=0; i<dssize; i++) {
         ds[i] = objToInteger(getoa(ob1,i));
       }
       if (size == 2) {
         DegreeShifto = ob1;
         DegreeShifto_size = dssize;
         DegreeShifto_vec = ds;
         rob = ob1;
       }else{
         ob2 = getoa(ob,2);
         if (ob2.tag == Spoly) {
           f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1,0);
           rob = KpoPOLY(f);
         }else if (ob2.tag == SuniversalNumber) {
           rob = ob2;
         }else if (ob2.tag == Sarray) {
           rob = newObjectArray(getoaSize(ob2));
           for (i=0; i<getoaSize(ob2); i++) {
             tob = newObjectArray(3);
             ob1t = newObjectArray(dssize);
             if (getoa(ob2,i).tag == Spoly) {
               for (j=0; j<dssize; j++) getoa(ob1t,j) = KpoInteger(0);
               for (j=0; j<dssize-i; j++) getoa(ob1t,j) = getoa(ob1,j+i);
             }else{
               ob1t = ob1;
             }
             getoa(tob,0) = ob0; getoa(tob,1) = ob1t; getoa(tob,2) = getoa(ob2,i);
             getoa(rob,i) = homogenizeObject_go(tob,gradep);
           }
         }else{
           errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");
         }
       }
     }else{
         errorKan1("%s\n","homogenizeObject_go(): unknown key word.");
     }
     return( rob );
   }
   
   
 struct ring *oRingp(ob)  struct ring *oRingp(ob)
      struct object ob;       struct object ob;
 {  {
Line 843  struct object oInitW(ob,oWeight)
Line 924  struct object oInitW(ob,oWeight)
   int w[2*N0];    int w[2*N0];
   int n,i;    int n,i;
   struct object ow;    struct object ow;
     int shiftvec;
     struct object oShift;
     int *s;
     int ssize,m;
   
     shiftvec = 0;
     s = NULL;
   
   if (oWeight.tag != Sarray) {    if (oWeight.tag != Sarray) {
     errorKan1("%s\n","oInitW(): the second argument must be array.");      errorKan1("%s\n","oInitW(): the second argument must be array.");
   }    }
   n = getoaSize(oWeight);    n = getoaSize(oWeight);
     if (n == 0) {
           m = getoaSize(ob);
           f = objArrayToPOLY(ob);
           f = head(f);
       return POLYtoObjArray(f,m);
     }
     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.");    if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
   for (i=0; i<n; i++) {    for (i=0; i<n; i++) {
     ow = getoa(oWeight,i);      ow = getoa(oWeight,i);
           if (ow.tag == SuniversalNumber) {
             ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
           }
     if (ow.tag != Sinteger) {      if (ow.tag != Sinteger) {
       errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");        errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");
     }      }
     w[i] = KopInteger(ow);      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) {    switch(ob.tag) {
   case Spoly:    case Spoly:
     f = KopPOLY(ob);      f = KopPOLY(ob);
     return( KpoPOLY(POLYToInitW(f,w)));          if (shiftvec) {
             return( KpoPOLY(POLYToInitWS(f,w,s)));
           }else{
             return( KpoPOLY(POLYToInitW(f,w)));
           }
     break;      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:    default:
     errorKan1("%s\n","oInitW(): Argument must be polynomial.");      errorKan1("%s\n","oInitW(): Argument must be polynomial or a vector of polynomials");
     break;      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;
                   if (n - ringp->nn <= 0) errorKan1("%s\n","Graduation variable in D is not given.");
         }
         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(coeffCopy(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;
   }
   
   struct object KordWsAll(ob,oWeight)
        struct object ob;
        struct object oWeight;
   {
     POLY f;
     struct object rob;
     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","ordWsAll(): the second argument must be array.");
     }
     n = getoaSize(oWeight);
     if (n == 0) {
           m = getoaSize(ob);
           f = objArrayToPOLY(ob);
           f = head(f);
       return POLYtoObjArray(f,m);
     }
     if (getoa(oWeight,0).tag == Sarray) {
           if (n != 2) errorKan1("%s\n","ordWsAll(): 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","ordWsAll(): the weight vector must be array.");
           }
           n = getoaSize(oWeight);
           if (oShift.tag != Sarray) {
             errorKan1("%s\n","ordWsAll(): the shift vector must be array.");
           }
     }
     /* oWeight = Ksm1WeightExpressionToVec(oWeight); */
     if (n >= 2*N0) errorKan1("%s\n","ordWsAll(): 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","ordWsAll(): 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","ordWsAll() 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","ordWsAll(): the entries of shift vector must be integers.");
             }
             s[i] = KopInteger(ow);
           }
     }
   
     switch(ob.tag) {
     case Spoly:
       f = KopPOLY(ob);
           if (f == POLYNULL) errorKan1("%s\n","ordWsAll(): the argument is 0");
           if (shiftvec) {
             return( KpoInteger(ordWsAll(f,w,s)));
           }else{
             return( KpoInteger(ordWsAll(f,w,(int *) NULL)));
           }
       break;
     case Sarray:
           m = getoaSize(ob);
           f = objArrayToPOLY(ob);
           if (f == POLYNULL) errorKan1("%s\n","ordWsAll(): the argument is 0");
           if (shiftvec) {
             return KpoInteger(ordWsAll(f,w,s));
           }else{
             return KpoInteger(ordWsAll(f,w,(int *)NULL));
           }
     default:
       errorKan1("%s\n","ordWsAll(): Argument must be polynomial or a vector of polynomials");
       break;
     }
   }
   
 int KpolyLength(POLY f) {  int KpolyLength(POLY f) {
   int size;    int size;
   if (f == POLYNULL) return(1);    if (f == POLYNULL) return(1);
Line 999  struct object KvectorToSchreyer_es(struct object obarr
Line 1294  struct object KvectorToSchreyer_es(struct object obarr
     }      }
   }    }
   return(KpoPOLY(f));    return(KpoPOLY(f));
   }
   
   int objToInteger(struct object ob) {
     if (ob.tag == Sinteger) {
       return KopInteger(ob);
     }else if (ob.tag == SuniversalNumber) {
       return(coeffToInt(KopUniversalNumber(ob)));
     }else {
       errorKan1("%s\n","objToInteger(): invalid argument.");
     }
 }  }
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.8
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>