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

Diff for /OpenXM/src/kan96xx/Kan/order.c between version 1.3 and 1.14

version 1.3, 2000/06/09 08:02:02 version 1.14, 2005/06/16 05:07:23
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/kan96xx/Kan/order.c,v 1.2 2000/01/16 07:55:39 takayama Exp $ */  /* $OpenXM: OpenXM/src/kan96xx/Kan/order.c,v 1.13 2004/09/13 11:24:11 takayama Exp $ */
 #include <stdio.h>  #include <stdio.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
Line 21  static void warningOrder(char *s);
Line 21  static void warningOrder(char *s);
 static void errorOrder(char *s);  static void errorOrder(char *s);
   
 void setOrderByMatrix(order,n,c,l,omsize)  void setOrderByMatrix(order,n,c,l,omsize)
 int order[];       int order[];
 int n,c,l,omsize;       int n,c,l,omsize;
 {  {
   int i,j;    int i,j;
   int *Order;    int *Order;
   extern struct ring *CurrentRingp;    extern struct ring *CurrentRingp;
   
   switch_mmLarger("default");    switch_mmLarger("default");
     /* q-case */    /* q-case */
   if ( l-c > 0) {    if ( l-c > 0) {
     switch_mmLarger("qmatrix");      switch_mmLarger("qmatrix");
   }    }
Line 46  int n,c,l,omsize;
Line 46  int n,c,l,omsize;
 }  }
   
 void showRing(level,ringp)  void showRing(level,ringp)
 int level;       int level;
 struct ring *ringp;       struct ring *ringp;
 {  {
   int i,j;    int i,j;
   FILE *fp;    FILE *fp;
Line 58  struct ring *ringp;
Line 58  struct ring *ringp;
   int P;    int P;
   char *mtype;    char *mtype;
   extern char *F_isSameComponent;    extern char *F_isSameComponent;
     POLY f;
     POLY fx;
     POLY fd;
     POLY rf;
   fp = stdout;    fp = stdout;
   
   N=ringp->n; M = ringp->m; L = ringp->l; C = ringp->c;    N=ringp->n; M = ringp->m; L = ringp->l; C = ringp->c;
Line 80  struct ring *ringp;
Line 84  struct ring *ringp;
     fprintf(fp,"\n");      fprintf(fp,"\n");
     fprintf(fp,"where ");      fprintf(fp,"where ");
     for (i=M; i<N; i++) {      for (i=M; i<N; i++) {
       fprintf(fp," %s %s - %s %s = 1, ",TransD[i],TransX[i],        fx = cxx(1,i,1,ringp); fd = cdd(1,i,1,ringp);
                                         TransX[i],TransD[i]);            rf = ppSub(ppMult(fd,fx),ppMult(fx,fd));
         fprintf(fp," %s %s - %s %s = %s, ",TransD[i],TransX[i],
                 TransX[i],TransD[i],POLYToString(rf,'*',0));
     }      }
     fprintf(fp,"\n\n");      fprintf(fp,"\n\n");
   }    }
Line 92  struct ring *ringp;
Line 98  struct ring *ringp;
     fprintf(fp,"\n");      fprintf(fp,"\n");
     fprintf(fp,"where ");      fprintf(fp,"where ");
     for (i=L; i<M; i++) {      for (i=L; i<M; i++) {
       fprintf(fp," %s %s - %s %s = %s, ",TransD[i],TransX[i],        fprintf(fp," %s %s - %s %s = ",TransD[i],TransX[i],
                                          TransX[i],TransD[i],                TransX[i],TransD[i]);
                                          TransD[i]);        f=ppSub(ppMult(cdd(1,i,1,ringp),cxx(1,i,1,ringp)),
                 ppMult(cxx(1,i,1,ringp),cdd(1,i,1,ringp)));
         fprintf(fp," %s, ",POLYToString(f,'*',0));
     }      }
     fprintf(fp,"\n\n");      fprintf(fp,"\n\n");
   }    }
Line 106  struct ring *ringp;
Line 114  struct ring *ringp;
     fprintf(fp,"where ");      fprintf(fp,"where ");
     for (i=C; i<L; i++) {      for (i=C; i<L; i++) {
       fprintf(fp," %s %s = %s %s %s, ",TransD[i],TransX[i],        fprintf(fp," %s %s = %s %s %s, ",TransD[i],TransX[i],
                                        TransX[0],                TransX[0],
                                        TransX[i],TransD[i]);                TransX[i],TransD[i]);
     }      }
     fprintf(fp,"\n\n");      fprintf(fp,"\n\n");
   }    }
Line 166  struct ring *ringp;
Line 174  struct ring *ringp;
     mtype = "unknown";      mtype = "unknown";
   }    }
   fprintf(fp,"Multiplication function --%s(%xH).\n",    fprintf(fp,"Multiplication function --%s(%xH).\n",
           mtype,(unsigned int) ringp->multiplication);            mtype,(unsigned int) ringp->multiplication);
   if (ringp->schreyer) {    if (ringp->schreyer) {
     fprintf(fp,"schreyer=1, gbListTower=");      fprintf(fp,"schreyer=1, gbListTower=");
     printObjectList((struct object *)(ringp->gbListTower));      printObjectList((struct object *)(ringp->gbListTower));
     fprintf(fp,"\n");      fprintf(fp,"\n");
   }    }
     if (ringp->degreeShiftSize) {
       fprintf(fp,"degreeShift vector (N=%d,Size=%d)= \n[\n",ringp->degreeShiftN,ringp->degreeShiftSize);
       {
         int i,j;
         for (i=0; i<ringp->degreeShiftN; i++) {
           fprintf(fp," [");
           for (j=0; j< ringp->degreeShiftSize; j++) {
             fprintf(fp," %d ",ringp->degreeShift[i*(ringp->degreeShiftSize)+j]);
           }
           fprintf(fp,"]\n");
         }
       }
       fprintf(fp,"]\n");
     }
     fprintf(fp,"---  weight vectors ---\n");
   if (level) printOrder(ringp);    if (level) printOrder(ringp);
   
     if (ringp->partialEcart) {
       fprintf(fp,"---  partialEcartGlobalVarX ---\n");
       for (i=0; i<ringp->partialEcart; i++) {
         fprintf(fp," %4s ",TransX[ringp->partialEcartGlobalVarX[i]]);
       }
       fprintf(fp,"\n");
     }
   
   if (ringp->next != (struct ring *)NULL) {    if (ringp->next != (struct ring *)NULL) {
     fprintf(fp,"\n\n-------- The next ring is .... --------------\n");      fprintf(fp,"\n\n-------- The next ring is .... --------------\n");
Line 203  if (isD(i))  D_{itod(i)}
Line 233  if (isD(i))  D_{itod(i)}
 */  */
   
 void printOrder(ringp)  void printOrder(ringp)
 struct ring *ringp;       struct ring *ringp;
 {  {
   int i,j;    int i,j;
   FILE *fp;    FILE *fp;
Line 245  struct ring *ringp;
Line 275  struct ring *ringp;
   fprintf(fp,"\n");    fprintf(fp,"\n");
   
   /* print D: differential     DE: differential, should be eliminated    /* print D: differential     DE: differential, should be eliminated
            E: difference       E: difference
            Q: q-difference       Q: q-difference
            C: commutative       C: commutative
   */    */
   if (strcmp(F_isSameComponent,"x")== 0 || strcmp(F_isSameComponent,"xd")==0) {    if (strcmp(F_isSameComponent,"x")== 0 || strcmp(F_isSameComponent,"xd")==0) {
     for (i=0; i<N; i++) {      for (i=0; i<N; i++) {
Line 296  struct ring *ringp;
Line 326  struct ring *ringp;
   
 struct object oGetOrderMatrix(struct ring *ringp)  struct object oGetOrderMatrix(struct ring *ringp)
 {  {
   struct object rob,ob2;    struct object rob = OINIT;
     struct object ob2 = OINIT;
   int n,i,j,m;    int n,i,j,m;
   int *om;    int *om;
   n = ringp->n;    n = ringp->n;
Line 316  struct object oGetOrderMatrix(struct ring *ringp)
Line 347  struct object oGetOrderMatrix(struct ring *ringp)
   
   
 int mmLarger_matrix(ff,gg)  int mmLarger_matrix(ff,gg)
 POLY ff; POLY gg;       POLY ff; POLY gg;
 {  {
   int exp[2*N0]; /* exponents */    int exp[2*N0]; /* exponents */
   int i,k;    int i,k;
Line 328  POLY ff; POLY gg;
Line 359  POLY ff; POLY gg;
   int in2;    int in2;
   int *from, *to;    int *from, *to;
   int omsize;    int omsize;
     int dssize;
     int dsn;
     int *degreeShiftVector;
   
   if (ff == POLYNULL ) {    if (ff == POLYNULL ) {
     if (gg == POLYNULL) return( 2 );      if (gg == POLYNULL) return( 2 );
Line 345  POLY ff; POLY gg;
Line 379  POLY ff; POLY gg;
   from = rp->from;    from = rp->from;
   to = rp->to;    to = rp->to;
   omsize = rp->orderMatrixSize;    omsize = rp->orderMatrixSize;
     if (dssize = rp->degreeShiftSize) {
           degreeShiftVector = rp->degreeShift;  /* Note. 2003.06.26 */
           dsn = rp->degreeShiftN;
     }
   
   flag = 1;    flag = 1;
   for (i=N-1,k=0; i>=0; i--,k++) {    for (i=N-1,k=0; i>=0; i--,k++) {
Line 361  POLY ff; POLY gg;
Line 399  POLY ff; POLY gg;
     sum = 0; in2 = i*2*N;      sum = 0; in2 = i*2*N;
     /* for (k=0; k<2*N; k++) sum += exp[k]*Order[in2+k]; */      /* for (k=0; k<2*N; k++) sum += exp[k]*Order[in2+k]; */
     for (k=from[i]; k<to[i]; k++) sum += exp[k]*Order[in2+k];      for (k=from[i]; k<to[i]; k++) sum += exp[k]*Order[in2+k];
       if (dssize && ( i < dsn)) { /* Note, 2003.06.26 */
         if ((f->e[N-1].x < dssize) && (f->e[N-1].x >= 0) &&
             (g->e[N-1].x < dssize) && (g->e[N-1].x >= 0)) {
           sum += degreeShiftVector[i*dssize+ (f->e[N-1].x)]
                 -degreeShiftVector[i*dssize+ (g->e[N-1].x)];
         }else{
           /*warningOrder("Size mismatch in the degree shift vector. It is ignored.");*/
         }
       }
     if (sum > 0) return(1);      if (sum > 0) return(1);
     if (sum < 0) return(0);      if (sum < 0) return(0);
   }    }
Line 369  POLY ff; POLY gg;
Line 416  POLY ff; POLY gg;
   
 /* This should be used in case of q */  /* This should be used in case of q */
 int mmLarger_qmatrix(ff,gg)  int mmLarger_qmatrix(ff,gg)
 POLY ff; POLY gg;       POLY ff; POLY gg;
 {  {
   int exp[2*N0]; /* exponents */    int exp[2*N0]; /* exponents */
   int i,k;    int i,k;
Line 418  POLY ff; POLY gg;
Line 465  POLY ff; POLY gg;
   
 /* x(N-1)>x(N-2)>....>D(N-1)>....>D(0) */  /* x(N-1)>x(N-2)>....>D(N-1)>....>D(0) */
 mmLarger_pureLexicographic(f,g)  mmLarger_pureLexicographic(f,g)
 POLY f;       POLY f;
 POLY g;       POLY g;
 {  {
   int i,r;    int i,r;
   int n;    int n;
Line 458  POLY g;
Line 505  POLY g;
   
   
 void setFromTo(ringp)  void setFromTo(ringp)
 struct ring *ringp;       struct ring *ringp;
 {  {
   int n;    int n;
   int i,j,oasize;    int i,j,oasize;
Line 474  struct ring *ringp;
Line 521  struct ring *ringp;
     ringp->from[i] = 0; ringp->to[i] = n;      ringp->from[i] = 0; ringp->to[i] = n;
     for (j=0; j<n; j++) {      for (j=0; j<n; j++) {
       if (ringp->order[i*n+j] != 0) {        if (ringp->order[i*n+j] != 0) {
         ringp->from[i] = j;          ringp->from[i] = j;
         break;          break;
       }        }
     }      }
     for (j=n-1; j>=0; j--) {      for (j=n-1; j>=0; j--) {
       if (ringp->order[i*n+j] != 0) {        if (ringp->order[i*n+j] != 0) {
         ringp->to[i] = j+1;          ringp->to[i] = j+1;
         break;          break;
       }        }
     }      }
   }    }
Line 490  struct ring *ringp;
Line 537  struct ring *ringp;
 /* It ignores h and should be used with mmLarger_tower */  /* It ignores h and should be used with mmLarger_tower */
 /* cf. mmLarger_matrix.  h always must be checked at last. */  /* cf. mmLarger_matrix.  h always must be checked at last. */
 static int mmLarger_matrix_schreyer(ff,gg)  static int mmLarger_matrix_schreyer(ff,gg)
 POLY ff; POLY gg;       POLY ff; POLY gg;
 {  {
   int exp[2*N0]; /* exponents */    int exp[2*N0]; /* exponents */
   int i,k;    int i,k;
Line 558  int mmLarger_tower(POLY f,POLY g) {
Line 605  int mmLarger_tower(POLY f,POLY g) {
   }    }
   if (!(f->m->ringp->schreyer) || !(g->m->ringp->schreyer))    if (!(f->m->ringp->schreyer) || !(g->m->ringp->schreyer))
     return(mmLarger_matrix(f,g));      return(mmLarger_matrix(f,g));
     /* modifiable: mmLarger_qmatrix */    /* modifiable: mmLarger_qmatrix */
   gbList = (struct object *)(g->m->ringp->gbListTower);    gbList = (struct object *)(g->m->ringp->gbListTower);
   if (gbList == NULL) return(mmLarger_matrix(f,g));    if (gbList == NULL) return(mmLarger_matrix(f,g));
                       /* modifiable: mmLarger_qmatrix */    /* modifiable: mmLarger_qmatrix */
   if (gbList->tag != Slist) {    if (gbList->tag != Slist) {
     warningOrder("mmLarger_tower(): gbList must be in Slist.\n");      warningOrder("mmLarger_tower(): gbList must be in Slist.\n");
     return(1);      return(1);
   }    }
   if (klength(gbList) ==0) return(mmLarger_matrix(f,g));    if (klength(gbList) ==0) return(mmLarger_matrix(f,g));
                       /* modifiable: mmLarger_qmatrix */    /* modifiable: mmLarger_qmatrix */
   
   r = mmLarger_tower3(f,g,gbList);    r = mmLarger_tower3(f,g,gbList);
   /* printf("mmLarger_tower3(%s,%s) -->  %d\n",POLYToString(head(f),'*',1),POLYToString(head(g),'*',1),r); */    /* printf("mmLarger_tower3(%s,%s) -->  %d\n",POLYToString(head(f),'*',1),POLYToString(head(g),'*',1),r); */
Line 585  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
Line 632  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
   int n,fv,gv,t,r,nn;    int n,fv,gv,t,r,nn;
   POLY fm;    POLY fm;
   POLY gm;    POLY gm;
   struct object gb;    struct object gb = OINIT;
   
   if (f == POLYNULL) {    if (f == POLYNULL) {
     if (g == POLYNULL)  return(2);      if (g == POLYNULL)  return(2);
Line 598  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
Line 645  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
   n = f->m->ringp->n;    n = f->m->ringp->n;
   nn = f->m->ringp->nn;    nn = f->m->ringp->nn;
   /* critical and modifiable */  /* m e_u > m e_v <==> m g_u > m g_v */    /* critical and modifiable */  /* m e_u > m e_v <==> m g_u > m g_v */
                                  /*                  or equal and u < v */    /*                  or equal and u < v */
   fv = f->m->e[nn].x ; /* extract component (vector) number of f! */    fv = f->m->e[nn].x ; /* extract component (vector) number of f! */
   gv = g->m->e[nn].x ;    gv = g->m->e[nn].x ;
   if (fv == gv) { /* They have the same component number. */    if (fv == gv) { /* They have the same component number. */
Line 606  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
Line 653  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
   }    }
   
   if (gbList == NULL) return(mmLarger_matrix_schreyer(f,g));    if (gbList == NULL) return(mmLarger_matrix_schreyer(f,g));
                       /* modifiable: mmLarger_qmatrix */    /* modifiable: mmLarger_qmatrix */
   if (gbList->tag != Slist) {    if (gbList->tag != Slist) {
     warningOrder("mmLarger_tower(): gbList must be in Slist.\n");      warningOrder("mmLarger_tower(): gbList must be in Slist.\n");
     return(1);      return(1);
   }    }
   if (klength(gbList) ==0) return(mmLarger_matrix(f,g));    if (klength(gbList) ==0) return(mmLarger_matrix(f,g));
                       /* modifiable: mmLarger_qmatrix */    /* modifiable: mmLarger_qmatrix */
   gb = car(gbList);  /* each entry must be monomials */    gb = car(gbList);  /* each entry must be monomials */
   if (gb.tag != Sarray) {    if (gb.tag != Sarray) {
     warningOrder("mmLarger_tower3(): car(gbList) must be an array.\n");      warningOrder("mmLarger_tower3(): car(gbList) must be an array.\n");
Line 626  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
Line 673  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
   if (fv >= t || gv >= t) {    if (fv >= t || gv >= t) {
     warningOrder("mmLarger_tower3(): incompatible input and gbList.\n");      warningOrder("mmLarger_tower3(): incompatible input and gbList.\n");
     printf("Length of gb is %d, f is %s, g is %s\n",t,KPOLYToString(f),      printf("Length of gb is %d, f is %s, g is %s\n",t,KPOLYToString(f),
            KPOLYToString(g));             KPOLYToString(g));
     KSexecuteString(" show_ring ");      KSexecuteString(" show_ring ");
     return(1);      return(1);
   }    }
Line 639  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
Line 686  int mmLarger_tower3(POLY f,POLY g,struct object *gbLis
   else if (fv > gv) return(0); /* modifiable */    else if (fv > gv) return(0); /* modifiable */
   else if (fv < gv) return(1); /* modifiable */    else if (fv < gv) return(1); /* modifiable */
 }  }
   
   static struct object auxPruneZeroRow(struct object ob) {
     int i,m,size;
     struct object obt = OINIT;
     struct object rob = OINIT;
     m = getoaSize(ob);
     size=0;
     for (i=0; i<m; i++) {
           obt = getoa(ob,i);
           if (getoaSize(obt) != 0) size++;
     }
     if (size == m) return ob;
     rob = newObjectArray(size);
     for (i=0, size=0; i<m; i++) {
           obt = getoa(ob,i);
           if (getoaSize(obt) != 0) {
             putoa(rob,size,obt); size++;
           }
     }
     return rob;
   }
   static struct object oRingToOXringStructure_long(struct ring *ringp)
   {
     struct object rob = OINIT;
     struct object ob2 = OINIT;
     struct object obMat = OINIT;
     struct object obV = OINIT;
     struct object obShift = OINIT;
     struct object obt = OINIT;
     char **TransX; char **TransD;
     int n,i,j,m,p,nonzero;
     int *om;
     n = ringp->n;
     m = ringp->orderMatrixSize;
     om = ringp->order;
     TransX = ringp->x; TransD = ringp->D;
     if (m<=0) m = 1;
     /*test: (1). getRing /rr set rr (oxRingStructure) dc  */
     obMat = newObjectArray(m);
     for (i=0; i<m; i++) {
       nonzero = 0;
       for (j=0; j<2*n; j++) {
         if (om[2*n*i+j] != 0) nonzero++;
       }
       ob2 = newObjectArray(nonzero*2);
       nonzero=0;
       for (j=0; j<2*n; j++) {
         /* fprintf(stderr,"%d, ",nonzero); */
         if (om[2*n*i+j] != 0) {
           if (j < n) {
             putoa(ob2,nonzero,KpoString(TransX[n-1-j])); nonzero++;
           }else{
             putoa(ob2,nonzero,KpoString(TransD[n-1-(j-n)])); nonzero++;
           }
           putoa(ob2,nonzero,KpoUniversalNumber(newUniversalNumber(om[2*n*i+j]))); nonzero++;
         }
       }
       /* printObject(ob2,0,stderr); fprintf(stderr,".\n"); */
       putoa(obMat,i,ob2);
     }
     obMat = auxPruneZeroRow(obMat);
     /* printObject(obMat,0,stderr); */
   
     obV = newObjectArray(2*n);
     for (i=0; i<n; i++) putoa(obV,i,KpoString(TransX[n-1-i]));
     for (i=0; i<n; i++) putoa(obV,i+n,KpoString(TransD[n-1-i]));
     /* printObject(obV,0,stderr); */
   
     if (ringp->degreeShiftSize) {
       /*test:
       [(x) ring_of_differential_operators [[(x)]] weight_vector 0
         [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] ] define_ring ;
        (1). getRing /rr set rr (oxRingStructure) dc message
       */
       obShift = newObjectArray(ringp->degreeShiftN);
       for (i=0; i<ringp->degreeShiftN; i++) {
         obt = newObjectArray(ringp->degreeShiftSize);
         for (j=0; j< ringp->degreeShiftSize; j++) {
           putoa(obt,j,KpoUniversalNumber(newUniversalNumber(ringp->degreeShift[i*(ringp->degreeShiftSize)+j])));
         }
         putoa(obShift,i,obt);
       }
       /* printObject(obShift,0,stderr); */
     }
   
     p = 0;
     if (ringp->degreeShiftSize) {
       rob = newObjectArray(3);
       obt = newObjectArray(2);
       putoa(obt,0,KpoString("degreeShift"));
       putoa(obt,1,obShift);
       putoa(rob,p, obt); p++;
     }else {
       rob = newObjectArray(2);
     }
   
     obt = newObjectArray(2);
     putoa(obt,0,KpoString("v"));
     putoa(obt,1,obV);
     putoa(rob,p, obt); p++;
   
     obt = newObjectArray(2);
     putoa(obt,0,KpoString("order"));
     putoa(obt,1,obMat);
     putoa(rob,p, obt); p++;
   
     return(rob);
   }
   static int auxEffectiveVar(int idx,int n) {
     int x;
     if (idx < n) x=1; else x=0;
     if (x) {
           if ((idx >= 1) && (idx < n-1)) return 1;
           else return 0;
     }else{
           if ( 1 <= idx-n )  return 1;
           else return 0;
     }
   }
   /*test:
      [(x,y) ring_of_differential_operators [[(Dx) 1 (Dy)  1]]
       weight_vector 0] define_ring
       (x). getRing (oxRingStructure) dc ::
    */
   static struct object oRingToOXringStructure_short(struct ring *ringp)
   {
     struct object rob = OINIT;
     struct object ob2 = OINIT;
     struct object obMat = OINIT;
     struct object obV = OINIT;
     struct object obShift = OINIT;
     struct object obt = OINIT;
     char **TransX; char **TransD;
     int n,i,j,m,p,nonzero;
     int *om;
     n = ringp->n;
     m = ringp->orderMatrixSize;
     om = ringp->order;
     TransX = ringp->x; TransD = ringp->D;
     if (m<=0) m = 1;
     /*test: (1). getRing /rr set rr (oxRingStructure) dc  */
     obMat = newObjectArray(m);
     for (i=0; i<m; i++) {
       nonzero = 0;
       for (j=0; j<2*n; j++) {
         if ((om[2*n*i+j] != 0) && auxEffectiveVar(j,n)) nonzero++;
       }
       ob2 = newObjectArray(nonzero*2);
       nonzero=0;
       for (j=0; j<2*n; j++) {
         /* fprintf(stderr,"%d, ",nonzero); */
         if ((om[2*n*i+j] != 0) && auxEffectiveVar(j,n)) {
           if (j < n) {
             putoa(ob2,nonzero,KpoString(TransX[n-1-j])); nonzero++;
           }else{
             putoa(ob2,nonzero,KpoString(TransD[n-1-(j-n)])); nonzero++;
           }
           putoa(ob2,nonzero,KpoUniversalNumber(newUniversalNumber(om[2*n*i+j]))); nonzero++;
         }
       }
       /* printObject(ob2,0,stderr); fprintf(stderr,".\n"); */
       putoa(obMat,i,ob2);
     }
     obMat = auxPruneZeroRow(obMat);
     /* printObject(obMat,0,stderr); */
   
     obV = newObjectArray(2*n-3);
     for (i=0; i<n-2; i++) putoa(obV,i,KpoString(TransX[n-1-i-1]));
     for (i=0; i<n-1; i++) putoa(obV,i+n-2,KpoString(TransD[n-1-i-1]));
     /* printObject(obV,0,stderr); */
   
     if (ringp->degreeShiftSize) {
       /*test:
       [(x) ring_of_differential_operators [[(x)]] weight_vector 0
         [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] ] define_ring ;
        (1). getRing /rr set rr (oxRingStructure) dc message
       */
       obShift = newObjectArray(ringp->degreeShiftN);
       for (i=0; i<ringp->degreeShiftN; i++) {
         obt = newObjectArray(ringp->degreeShiftSize);
         for (j=0; j< ringp->degreeShiftSize; j++) {
           putoa(obt,j,KpoUniversalNumber(newUniversalNumber(ringp->degreeShift[i*(ringp->degreeShiftSize)+j])));
         }
         putoa(obShift,i,obt);
       }
       /* printObject(obShift,0,stderr); */
     }
   
     p = 0;
     if (ringp->degreeShiftSize) {
       rob = newObjectArray(3);
       obt = newObjectArray(2);
       putoa(obt,0,KpoString("degreeShift"));
       putoa(obt,1,obShift);
       putoa(rob,p, obt); p++;
     }else {
       rob = newObjectArray(2);
     }
   
     obt = newObjectArray(2);
     putoa(obt,0,KpoString("v"));
     putoa(obt,1,obV);
     putoa(rob,p, obt); p++;
   
     obt = newObjectArray(2);
     putoa(obt,0,KpoString("order"));
     putoa(obt,1,obMat);
     putoa(rob,p, obt); p++;
   
     return(rob);
   }
   struct object oRingToOXringStructure(struct ring *ringp)
   {
     struct object rob = OINIT;
     struct object tob = OINIT;
     rob = newObjectArray(2);
     tob = oRingToOXringStructure_short(ringp);
     putoa(rob,0,tob);
     tob = oRingToOXringStructure_long(ringp);
     putoa(rob,1,tob);
     return(rob);
   }
   
 static void warningOrder(s)  static void warningOrder(s)
 char *s;       char *s;
 {  {
   fprintf(stderr,"Warning in order.c: %s\n",s);    fprintf(stderr,"Warning in order.c: %s\n",s);
 }  }
   
 static void errorOrder(s)  static void errorOrder(s)
 char *s;       char *s;
 {  {
   fprintf(stderr,"order.c: %s\n",s);    fprintf(stderr,"order.c: %s\n",s);
   exit(14);    exit(14);
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.14
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>