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

Diff for /OpenXM/src/kan96xx/Kan/Kclass/indeterminate.c between version 1.1 and 1.7

version 1.1, 1999/10/08 02:12:02 version 1.7, 2003/11/21 02:10:37
Line 1 
Line 1 
   /* $OpenXM: OpenXM/src/kan96xx/Kan/Kclass/indeterminate.c,v 1.6 2001/09/01 01:37:48 takayama Exp $ */
 /* Kclass/indeterminate.c    */  /* Kclass/indeterminate.c    */
 /* This file handles   indeterminate, tree, recursivePolynomial,  /* This file handles   indeterminate, recursivePolynomial,
     polynomialInOneVariable      polynomialInOneVariable
 */  */
 #include <stdio.h>  #include <stdio.h>
Line 42  void fprintIndeterminate(FILE *fp,struct object op)
Line 43  void fprintIndeterminate(FILE *fp,struct object op)
   printObject(KopIndeterminate(op),0,fp);    printObject(KopIndeterminate(op),0,fp);
 }  }
   
   /* Functions for trees are moved to tree.c */
 /* ---------------------------------------------------- */  /* ---------------------------------------------------- */
 /* Data conversion function : see KclassDataConversion*/  
 struct object KpoTree(struct object ob) {  
   struct object rob;  
   struct object ob1,ob2,ob3;  
   struct object *newobp;  
   rob.tag = Sclass;  
   rob.lc.ival = CLASSNAME_tree;  
   newobp = (struct object *) sGC_malloc(sizeof(struct object));  
   if (newobp == NULL) errorKan1("%s\n","Kclass/indeterminate.c, no more memory.");  
   if (ob.tag != Sarray) {  
     errorKan1("%s\n","Kclass/indeterminate.c, only properly formatted list object can be transformed into tree. [name, cdname, arglist].");  
   }  
   if (getoaSize(ob) < 3) {  
     errorKan1("%s\n","Kclass/indeterminate.c, the length must 3 or more than 3. [name, cdname, arglist].");  
   }  
   ob1 = getoa(ob,0); ob2 = getoa(ob,1); ob3 = getoa(ob,2);  
   if (ob1.tag != Sdollar || ob2.tag != Sdollar || ob3.tag != Sarray) {  
     errorKan1("%s\n","Kclass/indeterminate.c, [string name, string cdname, list arglist].");  
   }  
   *newobp = ob;  
   rob.rc.voidp = newobp;  
   return(rob);  
 }  
   
   
 /* Printing function : see fprintClass */  
 void fprintTree(FILE *fp,struct object op)  
 {  
   printObject(KopTree(op),0,fp);  
 }  
   
 int isTreeAdd(struct object ob) {  
   struct object name;  
   if (ob.tag != Sclass) {  
     return(0);  
   }  
   if (ectag(ob) != CLASSNAME_tree) {  
     return(0);  
   }  
   ob = KopTree(ob);  
   if (ob.tag != Sarray) {  
     errorKan1("%s\n","CLASSNAME_tree is broken. Should be array.");  
   }  
   name = getoa(ob,0);  
   if (name.tag != Sdollar) {  
     errorKan1("%s\n","CLASSNAME_tree is broken. Should be string.");  
   }  
   if (strcmp(KopString(name),"add") == 0) {  
     return(1);  
   }else{  
     return(0);  
   }  
 }  
   
 struct object addTree(struct object ob1, struct object ob2)  
 {  
   struct object rob,aob;  
   struct object ob3,ob4;  
   int i;  
   if (isTreeAdd(ob1) && !isTreeAdd(ob2)) {  
     ob1 = KopTree(ob1);  
     ob3 = getoa(ob1,2);  
     aob = newObjectArray(getoaSize(ob3)+1);  
     for (i=0; i<getoaSize(ob3); i++) {  
       putoa(aob,i,getoa(ob3,i));  
     }  
     putoa(aob,getoaSize(ob3),ob2);  
   }else if (!isTreeAdd(ob1) && isTreeAdd(ob2)) {  
     ob2 = KopTree(ob2);  
     ob3 = getoa(ob2,2);  
     aob = newObjectArray(getoaSize(ob3)+1);  
     putoa(aob,0,ob1);  
     for (i=0; i<getoaSize(ob3); i++) {  
       putoa(aob,1+i,getoa(ob3,i));  
     }  
   }else if (isTreeAdd(ob1) && isTreeAdd(ob2)) {  
     ob1 = KopTree(ob1);  
     ob2 = KopTree(ob2);  
     ob3 = getoa(ob1,2);  
     ob4 = getoa(ob2,2);  
     aob = newObjectArray(getoaSize(ob3)+getoaSize(ob4));  
     for (i=0; i<getoaSize(ob3); i++) {  
       putoa(aob,i,getoa(ob3,i));  
     }  
     for (i=0; i<getoaSize(ob4); i++) {  
       putoa(aob,getoaSize(ob3)+i,getoa(ob4,i));  
     }  
   }else{  
     aob = newObjectArray(2);  
     putoa(aob,0,ob1);  
     putoa(aob,1,ob2);  
   }  
   rob = newObjectArray(3);  
   putoa(rob,0,KpoString("add"));  
   putoa(rob,1,KpoString("Basic"));  
   putoa(rob,2,aob);  
   return(KpoTree(rob));  
 }  
   
   
 /*------------------------------------------*/  
   
 struct object KpoRecursivePolynomial(struct object ob) {  struct object KpoRecursivePolynomial(struct object ob) {
   struct object rob;    struct object rob;
   struct object *newobp;    struct object *newobp;
Line 162  struct object KpoRecursivePolynomial(struct object ob)
Line 62  struct object KpoRecursivePolynomial(struct object ob)
 }  }
   
 static void  printBodyOfRecursivePolynomial(struct object body,  static void  printBodyOfRecursivePolynomial(struct object body,
                                             struct object vlist, FILE *fp)                                              struct object vlist, FILE *fp)
 {  {
   int i,j;    int i,j;
   int k;    int k;
Line 181  static void  printBodyOfRecursivePolynomial(struct obj
Line 81  static void  printBodyOfRecursivePolynomial(struct obj
   for (j=1; j<getoaSize(body); j = j+2) {    for (j=1; j<getoaSize(body); j = j+2) {
     k = KopInteger(getoa(body,j));      k = KopInteger(getoa(body,j));
     if (k != 0) {      if (k != 0) {
       fprintf(fp,"%s",KopString(getoa(vlist,i)));        if (getoa(vlist,i).tag == Sdollar) {
           fprintf(fp,"%s",KopString(getoa(vlist,i)));
         }else if (ectag(getoa(vlist,i)) == CLASSNAME_tree) {
           fprintClass(fp,getoa(vlist,i));
         }else{
           errorKan1("%s\n","printBodyOfRecursivePolynomial: format error.");
         }
       if (k > 1) {        if (k > 1) {
         fprintf(fp,"^%d ",k);          fprintf(fp,"^%d ",k);
       }else if (k == 1) {        }else if (k == 1) {
       }else{        }else{
         fprintf(fp,"^(%d) ",k);          fprintf(fp,"^(%d) ",k);
       }        }
       fprintf(fp," * ");        fprintf(fp," * ");
     }      }
Line 203  static void  printBodyOfRecursivePolynomial(struct obj
Line 109  static void  printBodyOfRecursivePolynomial(struct obj
 void fprintRecursivePolynomial(FILE *fp,struct object op)  void fprintRecursivePolynomial(FILE *fp,struct object op)
 {  {
   /* old  code    /* old  code
   printObject(KopRecursivePolynomial(op),0,fp); return;       printObject(KopRecursivePolynomial(op),0,fp); return;
   */    */
   struct object ob;    struct object ob;
   struct object vlist;    struct object vlist;
Line 297  struct object polyToRecursivePoly(struct object p) {
Line 203  struct object polyToRecursivePoly(struct object p) {
   putoa(rob,0,vlist2); putoa(rob,1,ob1);    putoa(rob,0,vlist2); putoa(rob,1,ob1);
   /* format of rob    /* format of rob
      [ list of variables, poly or universalNumber or yyy to express       [ list of variables, poly or universalNumber or yyy to express
                           a recursive polynomial. ]       a recursive polynomial. ]
      format of yyy = CLASSNAME_polynomialInOneVariable       format of yyy = CLASSNAME_polynomialInOneVariable
      [Sinteger,    Sinteger, coeff obj, Sinteger, coeff obj, .....]       [Sinteger,    Sinteger, coeff obj, Sinteger, coeff obj, .....]
       name of var, exp,      coeff,     exp,      coeff       name of var, exp,      coeff,     exp,      coeff
     This format is checked by isRecursivePolynomial2().       This format is checked by isRecursivePolynomial2().
   */    */
   rob = KpoRecursivePolynomial(rob);    rob = KpoRecursivePolynomial(rob);
   if (isRecursivePolynomial2(rob)) {    if (isRecursivePolynomial2(rob)) {
Line 398  static int isRecursivePolynomial2a(struct object ob2, 
Line 304  static int isRecursivePolynomial2a(struct object ob2, 
     if (ectag(tmp) == CLASSNAME_polynomialInOneVariable) {      if (ectag(tmp) == CLASSNAME_polynomialInOneVariable) {
       if (isRecursivePolynomial2a(tmp,n)) {        if (isRecursivePolynomial2a(tmp,n)) {
       }else{        }else{
         fprintf(stderr,"isRecursivePolynomial2a: entry is not a polynomial in one variable.\n");          fprintf(stderr,"isRecursivePolynomial2a: entry is not a polynomial in one variable.\n");
         printObject(tmp,0,stderr); fprintf(stderr,"\n");          printObject(tmp,0,stderr); fprintf(stderr,"\n");
         return(0);          return(0);
       }        }
     }      }
   }    }
Line 434  int isRecursivePolynomial2(struct object ob) {
Line 340  int isRecursivePolynomial2(struct object ob) {
   n = getoaSize(ob1);    n = getoaSize(ob1);
   for (i=0; i<n; i++) {    for (i=0; i<n; i++) {
     tmp = getoa(ob1,i);      tmp = getoa(ob1,i);
     if (tmp.tag != Sdollar) {      if (tmp.tag == Sdollar) {
       fprintf(stderr,"%s [list vlist, body]. Element of the vlist must be a string.\n",s); printObject(ob,1,stderr);      }else if (ectag(tmp) == CLASSNAME_tree) {
       }else{
         fprintf(stderr,"%s [list vlist, body]. Element of the vlist must be a string or a tree.\n",s); printObject(ob,1,stderr);
       return(0);        return(0);
     }      }
   }    }
Line 477  struct object recursivePolyToPoly(struct object rp) {
Line 385  struct object recursivePolyToPoly(struct object rp) {
 }  }
   
   
   struct object KrvtReplace(struct object rp_o,struct object v_o, struct object t_o) {
     /* rp_o : recursive polynomial.
        v_o  : variable name (indeterminate).
        t_o  : tree.
     */
     struct object rp, vlist, newvlist, newrp;
     int i,m;
     /* Check the data types. */
     if (ectag(rp_o) != CLASSNAME_recursivePolynomial) {
       errorKan1("%s\n","KrvtReplace() type mismatch in the first argument.");
     }
     if (ectag(v_o) != CLASSNAME_indeterminate) {
       errorKan1("%s\n","KrvtReplace() type mismatch in the second argument.");
     }
     if (ectag(t_o) != CLASSNAME_tree) {
       errorKan1("%s\n","KrvtReplace() type mismatch in the third argument.");
     }
   
     rp = KopRecursivePolynomial(rp_o);
     vlist = getoa(rp,0);
     m = getoaSize(vlist);
     newvlist = newObjectArray(m);
     for (i=0; i<m; i++) {
       if (KooEqualQ(getoa(vlist,i),KopIndeterminate(v_o))) {
         /* should be KooEqualQ(getoa(vlist,i),v_o). It's not a bug.
            Internal expression of vlist is an array of string
            (not indetermiante). */
         putoa(newvlist,i,t_o);
       }else{
         putoa(newvlist,i,getoa(vlist,i));
       }
     }
     newrp = newObjectArray(getoaSize(rp));
     m = getoaSize(rp);
     putoa(newrp,0,newvlist);
     for (i=1; i<m; i++) {
       putoa(newrp,i,getoa(rp,i));
     }
     return(KpoRecursivePolynomial(newrp));
   }
   
   
   struct object KreplaceRecursivePolynomial(struct object of,struct object rule) {
     struct object rob,f;
     int i;
     int n;
     struct object trule;
   
   
     if (rule.tag != Sarray) {
       errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be array.");
     }
     n = getoaSize(rule);
   
     if (of.tag ==Sclass && ectag(of) == CLASSNAME_recursivePolynomial) {
     }else{
       errorKan1("%s\n"," KreplaceRecursivePolynomial(): The first argument must be a recursive polynomial.");
     }
     f = of;
   
     for (i=0; i<n; i++) {
       trule = getoa(rule,i);
       if (trule.tag != Sarray) {
         errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....].");
       }
       if (getoaSize(trule) != 2) {
         errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....].");
       }
   
       if (ectag(getoa(trule,0)) != CLASSNAME_indeterminate) {
         errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
       }
       /* Do not check the second argument. */
       /*
         if (getoa(trule,1).tag != Spoly) {
         errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
         }
       */
   
     }
   
     rob = f;
     for (i=0; i<n; i++) {
       trule = getoa(rule,i);
       rob = KrvtReplace(rob,getoa(trule,0),getoa(trule,1));
     }
     return(rob);
   }
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>