[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.1 and 1.6

version 1.1, 1999/10/08 02:12:02 version 1.6, 2003/08/21 12:28:57
Line 1 
Line 1 
   /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.5 2003/07/17 07:33: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;
 struct object set;       struct object set;
 {  {
   POLY r;    POLY r;
   struct gradedPolySet *grG;    struct gradedPolySet *grG;
Line 38  struct object set;
Line 43  struct object 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 54  struct object set;
Line 60  struct object set;
 }  }
   
 struct object Kgroebner(ob)  struct object Kgroebner(ob)
 struct object ob;       struct object ob;
 {  {
   int needSyz = 0;    int needSyz = 0;
   int needBack = 0;    int needBack = 0;
Line 112  struct object ob;
Line 118  struct object ob;
     for (i=0; i<getoaSize(ob2); i++) {      for (i=0; i<getoaSize(ob2); i++) {
       ob2c = getoa(ob2,i);        ob2c = getoa(ob2,i);
       if (ob2c.tag == Sdollar) {        if (ob2c.tag == Sdollar) {
         if (strcmp(ob2c.lc.str,"needBack")==0) {          if (strcmp(ob2c.lc.str,"needBack")==0) {
           needBack = 1;            needBack = 1;
         }else if (strcmp(ob2c.lc.str,"needSyz")==0) {          }else if (strcmp(ob2c.lc.str,"needSyz")==0) {
           if (!needBack) {            if (!needBack) {
             /* warningKan("Kgroebner(): needBack is automatically set."); */              /* warningKan("Kgroebner(): needBack is automatically set."); */
           }            }
           needSyz = needBack = 1;            needSyz = needBack = 1;
         }else if (strcmp(ob2c.lc.str,"forceReduction")==0) {          }else if (strcmp(ob2c.lc.str,"forceReduction")==0) {
           forceReduction = 1;            forceReduction = 1;
         }else if (strcmp(ob2c.lc.str,"countDown")==0) {          }else if (strcmp(ob2c.lc.str,"countDown")==0) {
           countDown = 1; cdflag = 1;            countDown = 1; cdflag = 1;
           if (needSyz) {            if (needSyz) {
             warningKan("Kgroebner(): needSyz is automatically turned off.");              warningKan("Kgroebner(): needSyz is automatically turned off.");
             needSyz = 0;              needSyz = 0;
           }            }
         }else if (strcmp(ob2c.lc.str,"StopDegree")==0) {          }else if (strcmp(ob2c.lc.str,"StopDegree")==0) {
           StopDegree = 0; sdflag = 1;            StopDegree = 0; sdflag = 1;
           if (needSyz) {            if (needSyz) {
             warningKan("Kgroebner(): needSyz is automatically turned off.");              warningKan("Kgroebner(): needSyz is automatically turned off.");
             needSyz = 0;              needSyz = 0;
           }            }
         }else {          }else {
           warningKan("Unknown keyword for options.");            warningKan("Unknown keyword for options.");
         }          }
       }else if (ob2c.tag == Sinteger) {        }else if (ob2c.tag == Sinteger) {
         if (cdflag) {          if (cdflag) {
           cdflag = 0;            cdflag = 0;
           countDown = KopInteger(ob2c);            countDown = KopInteger(ob2c);
         }else if (sdflag) {          }else if (sdflag) {
           sdflag = 0;            sdflag = 0;
           StopDegree = KopInteger(ob2c);            StopDegree = KopInteger(ob2c);
         }          }
       }        }
     }      }
     break;      break;
   default:    default:
     errorKan1("%s\n","Kgroebner(): [ [polynomials] ] or [[polynomials] [options]].");      errorKan1("%s\n","Kgroebner(): [ [polynomials] ] or [[polynomials] [options]].");
   }    }
   
   if (ob1.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array. Example: [ [$x-1$ . $x y -2$ .] [$needBack$ $needSyz$ $needInput$]] ");    if (ob1.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array. Example: [ [$x-1$ . $x y -2$ .] [$needBack$ $needSyz$ $needInput$]] ");
   ob1New = newObjectArray(getoaSize(ob1));    ob1New = newObjectArray(getoaSize(ob1));
   for (i=0; i< getoaSize(ob1); i++) {    for (i=0; i< getoaSize(ob1); i++) {
Line 165  struct object ob;
Line 171  struct object ob;
     /* getoa(ob1,i) is poly, now check the homogenization. */      /* getoa(ob1,i) is poly, now check the homogenization. */
     if (CheckHomogenization) {      if (CheckHomogenization) {
       if ((strcmp(F_groebner,"standard")==0) &&        if ((strcmp(F_groebner,"standard")==0) &&
           !isHomogenized(KopPOLY(getoa(ob1New,i)))) {            !isHomogenized(KopPOLY(getoa(ob1New,i)))) {
         fprintf(stderr,"\n%s",KPOLYToString(KopPOLY(getoa(ob1New,i))));          fprintf(stderr,"\n%s",KPOLYToString(KopPOLY(getoa(ob1New,i))));
         errorKan1("%s\n","Kgroebner(): The above polynomial is not homogenized. cf. homogenize.");          errorKan1("%s\n","Kgroebner(): The above polynomial is not homogenized. cf. homogenize.");
       }        }
     }      }
   }    }
Line 208  struct object ob;
Line 214  struct object ob;
       putoa(rob,1,rob3);        putoa(rob,1,rob3);
       rob4 = newObjectArray(ob1Size);        rob4 = newObjectArray(ob1Size);
       for (i=0; i<ob1Size; i++) {        for (i=0; i<ob1Size; i++) {
         putoa(rob4,i,unitVector(i,ob1Size,myring));          putoa(rob4,i,unitVector(i,ob1Size,myring));
       }        }
       putoa(rob,2,rob4);        putoa(rob,2,rob4);
     }else if (needBack) {      }else if (needBack) {
Line 368  static struct object unitVector(int pos, int size,stru
Line 374  static struct object unitVector(int pos, int size,stru
 #define INITSIZE 0  #define INITSIZE 0
   
 struct gradedPolySet *arrayToGradedPolySet(ob)  struct gradedPolySet *arrayToGradedPolySet(ob)
 struct object ob;       struct object ob;
 {  {
   int n,i,grd,ind;    int n,i,grd,ind;
   POLY f;    POLY f;
Line 398  struct object ob;
Line 404  struct object ob;
   
   
 struct object polySetToArray(ps,keepRedundant)  struct object polySetToArray(ps,keepRedundant)
 struct polySet *ps;       struct polySet *ps;
 int keepRedundant;       int keepRedundant;
 {  {
   int n,i,j;    int n,i,j;
   struct object ob;    struct object ob;
Line 425  int keepRedundant;
Line 431  int keepRedundant;
   
   
 struct object gradedPolySetToGradedArray(gps,keepRedundant)  struct object gradedPolySetToGradedArray(gps,keepRedundant)
 struct gradedPolySet *gps;       struct gradedPolySet *gps;
 int keepRedundant;       int keepRedundant;
 {  {
   struct object ob,vec;    struct object ob,vec;
   int i;    int i;
Line 443  int keepRedundant;
Line 449  int keepRedundant;
   
   
 struct object gradedPolySetToArray(gps,keepRedundant)  struct object gradedPolySetToArray(gps,keepRedundant)
 struct gradedPolySet *gps;       struct gradedPolySet *gps;
 int keepRedundant;       int keepRedundant;
 {  {
   struct object ob,vec;    struct object ob,vec;
   struct polySet *ps;    struct polySet *ps;
Line 459  int keepRedundant;
Line 465  int keepRedundant;
       size += ps->size;        size += ps->size;
     }else{      }else{
       for (j=0; j<ps->size; j++) {        for (j=0; j<ps->size; j++) {
         if (ps->del[j] == 0) ++size;          if (ps->del[j] == 0) ++size;
       }        }
     }      }
   }    }
Line 470  int keepRedundant;
Line 476  int keepRedundant;
     ps = gps->polys[i];      ps = gps->polys[i];
     for (j=0; j<ps->size; j++) {      for (j=0; j<ps->size; j++) {
       if (keepRedundant || (ps->del[j] == 0)) {        if (keepRedundant || (ps->del[j] == 0)) {
         putoa(ob,k,KpoPOLY(ps->g[j]));          putoa(ob,k,KpoPOLY(ps->g[j]));
         k++;          k++;
       }        }
     }      }
   }    }
Line 481  int keepRedundant;
Line 487  int keepRedundant;
   
 /* serial == -1  :  It's not in the marix input. */  /* serial == -1  :  It's not in the marix input. */
 struct object syzPolyToArray(size,f,grG)  struct object syzPolyToArray(size,f,grG)
 int size;       int size;
 POLY f;       POLY f;
 struct gradedPolySet *grG;       struct gradedPolySet *grG;
 {  {
   struct object ob;    struct object ob;
   int i,g0,i0,serial;    int i,g0,i0,serial;
Line 495  struct gradedPolySet *grG;
Line 501  struct gradedPolySet *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 510  struct gradedPolySet *grG;
Line 516  struct gradedPolySet *grG;
 }  }
   
 struct object getBackwardArray(grG)  struct object getBackwardArray(grG)
 struct gradedPolySet *grG;       struct gradedPolySet *grG;
 {  {
   /* use serial, del.  cf. getBackwardTransformation(). */    /* use serial, del.  cf. getBackwardTransformation(). */
   int inputSize,outputSize;    int inputSize,outputSize;
Line 533  struct gradedPolySet *grG;
Line 539  struct gradedPolySet *grG;
     ps = grG->polys[i];      ps = grG->polys[i];
     for (j=0; j<ps->size; j++) {      for (j=0; j<ps->size; j++) {
       if (ps->del[j] == 0) {        if (ps->del[j] == 0) {
         putoa(ob,k,syzPolyToArray(inputSize,ps->syz[j]->syz,grG));          putoa(ob,k,syzPolyToArray(inputSize,ps->syz[j]->syz,grG));
         k++;          k++;
       }        }
     }      }
   }    }
Line 543  struct gradedPolySet *grG;
Line 549  struct gradedPolySet *grG;
   
   
 POLY arrayToPOLY(ob)  POLY arrayToPOLY(ob)
 struct object ob;       struct object ob;
 {  {
   int size,i;    int size,i;
   struct object f;    struct object f;
Line 563  struct object ob;
Line 569  struct object ob;
     if (ff != ZERO) {      if (ff != ZERO) {
       tf = ff->m;        tf = ff->m;
       if (tf->ringp != cr) {        if (tf->ringp != cr) {
         n = tf->ringp->n;          n = tf->ringp->n;
         m = tf->ringp->m;          m = tf->ringp->m;
         l = tf->ringp->l;          l = tf->ringp->l;
         c = tf->ringp->c;          c = tf->ringp->c;
         nn = tf->ringp->nn;          nn = tf->ringp->nn;
         mm = tf->ringp->mm;          mm = tf->ringp->mm;
         ll = tf->ringp->ll;          ll = tf->ringp->ll;
         cc = tf->ringp->cc;          cc = tf->ringp->cc;
         cr = tf->ringp;          cr = tf->ringp;
       }        }
       if (n-nn >0) ee = cxx(1,n-1,i,tf->ringp);        if (n-nn >0) ee = cxx(1,n-1,i,tf->ringp);
       else if (m-mm >0) ee = cxx(1,m-1,i,tf->ringp);        else if (m-mm >0) ee = cxx(1,m-1,i,tf->ringp);
Line 585  struct object ob;
Line 591  struct object ob;
 }  }
   
 struct object POLYToArray(ff)  struct object POLYToArray(ff)
 POLY ff;       POLY ff;
 {  {
   
   static int nn,mm,ll,cc,n,m,l,c;    static int nn,mm,ll,cc,n,m,l,c;
Line 639  POLY ff;
Line 645  POLY ff;
 }  }
   
 static int isThereh(f)  static int isThereh(f)
 POLY f;       POLY f;
 {  {
   POLY t;    POLY t;
   if (f == 0) return(0);    if (f == 0) return(0);
Line 652  POLY f;
Line 658  POLY f;
 }  }
   
 struct object homogenizeObject(ob,gradep)  struct object homogenizeObject(ob,gradep)
 struct object ob;       struct object ob;
 int *gradep;       int *gradep;
 {  {
   struct object rob,ob1;    struct object rob,ob1;
   int maxg;    int maxg;
Line 683  int *gradep;
Line 689  int *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 690  int *gradep;
Line 697  int *gradep;
       ob1 = getoa(ob,i);        ob1 = getoa(ob,i);
       ob1 = homogenizeObject(ob1,&gr);        ob1 = homogenizeObject(ob1,&gr);
       if (gr > maxg) {        if (gr > maxg) {
         maxg = gr;          maxg = gr;
       }        }
       getoa(rob,i) = ob1;        getoa(rob,i) = ob1;
     }      }
Line 699  int *gradep;
Line 706  int *gradep;
       rp = oRingp(rob);        rp = oRingp(rob);
       if (rp == (struct ring *)NULL) rp = CurrentRingp;        if (rp == (struct ring *)NULL) rp = CurrentRingp;
       for (i=0; i<size; i++) {        for (i=0; i<size; i++) {
         gr = oGrade(getoa(rob,i));          gr = oGrade(getoa(rob,i));
         /**printf("maxg=%d, gr=%d(i=%d) ",maxg,gr,i); fflush(stdout);**/          /**printf("maxg=%d, gr=%d(i=%d) ",maxg,gr,i); fflush(stdout);**/
         if (maxg > gr) {          if (maxg > gr) {
           f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */            f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */
           getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i));            getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i));
         }          }
       }        }
     }      }
     *gradep = maxg;      *gradep = maxg;
Line 717  int *gradep;
Line 724  int *gradep;
 }  }
   
 struct object homogenizeObject_vec(ob,gradep)  struct object homogenizeObject_vec(ob,gradep)
 struct object ob;       struct object ob;
 int *gradep;       int *gradep;
 {  {
   struct object rob,ob1;    struct object rob,ob1;
   int maxg;    int maxg;
Line 744  int *gradep;
Line 751  int *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);
       ob1 = homogenizeObject_vec(ob1,&gr);        ob1 = homogenizeObject_vec(ob1,&gr);
       if (i==0) maxg = gr;        if (i==0) maxg = gr;
       else {        else {
         maxg = (maxg > gr? maxg: gr);          maxg = (maxg > gr? maxg: gr);
       }        }
       putoa(rob,i,ob1);        putoa(rob,i,ob1);
     }      }
Line 763  int *gradep;
Line 771  int *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;
 {  {
   struct ring *rp,*rptmp;    struct ring *rp,*rptmp;
   int i,size;    int i,size;
Line 791  struct object ob;
Line 872  struct object ob;
 }  }
   
 int oGrade(ob)  int oGrade(ob)
 struct object ob;       struct object ob;
 {  {
   int i,size;    int i,size;
   POLY f;    POLY f;
Line 819  struct object ob;
Line 900  struct object ob;
   
   
 struct object oPrincipalPart(ob)  struct object oPrincipalPart(ob)
 struct object ob;       struct object ob;
 {  {
   POLY f;    POLY f;
   struct object rob;    struct object rob;
Line 835  struct object ob;
Line 916  struct object ob;
   }    }
 }  }
 struct object oInitW(ob,oWeight)  struct object oInitW(ob,oWeight)
 struct object ob;       struct object ob;
 struct object oWeight;       struct object oWeight;
 {  {
   POLY f;    POLY f;
   struct object rob;    struct object rob;
Line 993  struct object KvectorToSchreyer_es(struct object obarr
Line 1074  struct object KvectorToSchreyer_es(struct object obarr
       /*   g = es^i  g */        /*   g = es^i  g */
       g = mpMult_poly(cxx(1,nn,i,rp), g);        g = mpMult_poly(cxx(1,nn,i,rp), g);
       if (!isOrdered(g)) {        if (!isOrdered(g)) {
         errorKan1("%s\n","KvectorToSchreyer_es(): given polynomial is not ordered properly by the given Schreyer order.");          errorKan1("%s\n","KvectorToSchreyer_es(): given polynomial is not ordered properly by the given Schreyer order.");
       }        }
       f = ppAdd(f,g);        f = ppAdd(f,g);
     }      }
   }    }
   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.1  
changed lines
  Added in v.1.6
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>