[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.9 and 1.14

version 1.9, 2003/08/26 12:46:05 version 1.14, 2005/06/16 05:07:23
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/kan96xx/Kan/order.c,v 1.8 2003/06/26 13:00:11 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 196  void showRing(level,ringp) 
Line 196  void showRing(level,ringp) 
   }    }
   fprintf(fp,"---  weight vectors ---\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 318  void printOrder(ringp)
Line 326  void printOrder(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 623  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 677  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;
 {  {
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.14
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>