[BACK]Return to array.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/array.c between version 1.44 and 1.49

version 1.44, 2005/01/12 10:38:07 version 1.49, 2005/12/21 23:18:15
Line 45 
Line 45 
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *   *
  * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.43 2004/12/18 16:50:10 saito Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.48 2005/11/27 05:37:53 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "base.h"  #include "base.h"
Line 64  extern int DP_Print; /* XXX */
Line 64  extern int DP_Print; /* XXX */
   
 void Pnewvect(), Pnewmat(), Psepvect(), Psize(), Pdet(), Pleqm(), Pleqm1(), Pgeninvm();  void Pnewvect(), Pnewmat(), Psepvect(), Psize(), Pdet(), Pleqm(), Pleqm1(), Pgeninvm();
 void Pinvmat();  void Pinvmat();
 void Pnewbytearray();  void Pnewbytearray(),Pmemoryplot_to_coord();
   
 void Pgeneric_gauss_elim();  void Pgeneric_gauss_elim();
 void Pgeneric_gauss_elim_mod();  void Pgeneric_gauss_elim_mod();
Line 107  struct ftab array_tab[] = {
Line 107  struct ftab array_tab[] = {
         {"matr",Pmat,-99999999},          {"matr",Pmat,-99999999},
         {"matc",Pmatc,-99999999},          {"matc",Pmatc,-99999999},
         {"newbytearray",Pnewbytearray,-2},          {"newbytearray",Pnewbytearray,-2},
           {"memoryplot_to_coord",Pmemoryplot_to_coord,1},
         {"sepmat_destructive",Psepmat_destructive,2},          {"sepmat_destructive",Psepmat_destructive,2},
         {"sepvect",Psepvect,2},          {"sepvect",Psepvect,2},
         {"qsort",Pqsort,-2},          {"qsort",Pqsort,-2},
Line 158  int generic_comp_obj(Obj *a,Obj *b)
Line 159  int generic_comp_obj(Obj *a,Obj *b)
 }  }
   
   
 void Pqsort(NODE arg,VECT *rp)  void Pqsort(NODE arg,LIST *rp)
 {  {
         VECT vect;          VECT vect;
         NODE n,n1;          NODE n,n1;
Line 205  void Pqsort(NODE arg,VECT *rp)
Line 206  void Pqsort(NODE arg,VECT *rp)
         for ( i = len - 1, n = 0; i >= 0; i-- ) {          for ( i = len - 1, n = 0; i >= 0; i-- ) {
             MKNODE(n1,a[i],n); n = n1;              MKNODE(n1,a[i],n); n = n1;
         }          }
         MKLIST((LIST)*rp,n);          MKLIST(*rp,n);
     }else {      }else {
         *rp = vect;          *rp = (LIST)vect;
     }      }
 }  }
   
Line 477  void Pnewbytearray(NODE arg,BYTEARRAY *rp)
Line 478  void Pnewbytearray(NODE arg,BYTEARRAY *rp)
         *rp = array;          *rp = array;
 }  }
   
   #define MEMORY_GETPOINT(a,len,x,y) (((a)[(len)*(y)+((x)>>3)])&(1<<((x)&7)))
   
   void Pmemoryplot_to_coord(NODE arg,LIST *rp)
   {
           int len,blen,y,i,j;
           char *a;
           NODE r0,r,n;
           LIST l;
           BYTEARRAY ba;
           Q iq,jq;
   
           asir_assert(ARG0(arg),O_LIST,"memoryplot_to_coord");
           arg = BDY((LIST)ARG0(arg));
           len = QTOS((Q)ARG0(arg));
           blen = (len+7)/8;
           y = QTOS((Q)ARG1(arg));
           ba = (BYTEARRAY)ARG2(arg); a = ba->body;
           r0 = 0;
           for ( j = 0; j < y; j++ )
                   for ( i = 0; i < len; i++ )
                           if ( MEMORY_GETPOINT(a,blen,i,j) ) {
                                   NEXTNODE(r0,r);
                                   STOQ(i,iq); STOQ(j,jq);
                                   n = mknode(2,iq,jq);
                                   MKLIST(l,n);
                                   BDY(r) = l;
                           }
           if ( r0 ) NEXT(r) = 0;
           MKLIST(*rp,r0);
   }
   
 void Pnewmat(NODE arg,MAT *rp)  void Pnewmat(NODE arg,MAT *rp)
 {  {
         int row,col;          int row,col;
Line 832  void Pinvmat(NODE arg,LIST *rp)
Line 864  void Pinvmat(NODE arg,LIST *rp)
         input : a row x col matrix A          input : a row x col matrix A
                 A[I] <-> A[I][0]*x_0+A[I][1]*x_1+...                  A[I] <-> A[I][0]*x_0+A[I][1]*x_1+...
   
         output : [B,R,C]          output : [B,D,R,C]
                 B : a rank(A) x col-rank(A) matrix                  B : a rank(A) x col-rank(A) matrix
                   D : the denominator
                 R : a vector of length rank(A)                  R : a vector of length rank(A)
                 C : a vector of length col-rank(A)                  C : a vector of length col-rank(A)
                 B[I] <-> x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...                  B[I] <-> D*x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...
 */  */
   
 void Pgeneric_gauss_elim(NODE arg,LIST *rp)  void Pgeneric_gauss_elim(NODE arg,LIST *rp)
 {  {
         NODE n0;          NODE n0,opt,p;
         MAT m,nm;          MAT m,nm;
         int *ri,*ci;          int *ri,*ci;
         VECT rind,cind;          VECT rind,cind;
         Q dn,q;          Q dn,q;
         int i,j,k,l,row,col,t,rank;          int i,j,k,l,row,col,t,rank;
           int is_hensel = 0;
           char *key;
           Obj value;
   
           if ( current_option ) {
                   for ( opt = current_option; opt; opt = NEXT(opt) ) {
                           p = BDY((LIST)BDY(opt));
                           key = BDY((STRING)BDY(p));
                           value = (Obj)BDY(NEXT(p));
                           if ( !strcmp(key,"hensel") && value ) {
                                   is_hensel = value ? 1 : 0;
                                   break;
                           }
                   }
           }
         asir_assert(ARG0(arg),O_MAT,"generic_gauss_elim");          asir_assert(ARG0(arg),O_MAT,"generic_gauss_elim");
         m = (MAT)ARG0(arg);          m = (MAT)ARG0(arg);
         row = m->row; col = m->col;          row = m->row; col = m->col;
         rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);          if ( is_hensel )
                   rank = generic_gauss_elim_hensel(m,&nm,&dn,&ri,&ci);
           else
                   rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);
         t = col-rank;          t = col-rank;
         MKVECT(rind,rank);          MKVECT(rind,rank);
         MKVECT(cind,t);          MKVECT(cind,t);
Line 875  void Pgeneric_gauss_elim(NODE arg,LIST *rp)
Line 925  void Pgeneric_gauss_elim(NODE arg,LIST *rp)
                 B : a rank(A) x col-rank(A) matrix                  B : a rank(A) x col-rank(A) matrix
                 R : a vector of length rank(A)                  R : a vector of length rank(A)
                 C : a vector of length col-rank(A)                  C : a vector of length col-rank(A)
                   RN : a vector of length rank(A) indicating useful rows
   
                 B[I] <-> x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...                  B[I] <-> x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...
 */  */
   
Line 882  void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
Line 934  void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
 {  {
         NODE n0;          NODE n0;
         MAT m,mat;          MAT m,mat;
         VECT rind,cind;          VECT rind,cind,rnum;
         Q **tmat;          Q **tmat;
         int **wmat;          int **wmat,**row0;
         Q *rib,*cib;          Q *rib,*cib,*rnb;
         int *colstat;          int *colstat,*p;
         Q q;          Q q;
         int md,i,j,k,l,row,col,t,rank;          int md,i,j,k,l,row,col,t,rank;
   
Line 895  void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
Line 947  void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
         m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));          m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));
         row = m->row; col = m->col; tmat = (Q **)m->body;          row = m->row; col = m->col; tmat = (Q **)m->body;
         wmat = (int **)almat(row,col);          wmat = (int **)almat(row,col);
   
           row0 = (int **)ALLOCA(row*sizeof(int *));
           for ( i = 0; i < row; i++ ) row0[i] = wmat[i];
   
         colstat = (int *)MALLOC_ATOMIC(col*sizeof(int));          colstat = (int *)MALLOC_ATOMIC(col*sizeof(int));
         for ( i = 0; i < row; i++ )          for ( i = 0; i < row; i++ )
                 for ( j = 0; j < col; j++ )                  for ( j = 0; j < col; j++ )
Line 907  void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
Line 963  void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
                                 wmat[i][j] = 0;                                  wmat[i][j] = 0;
         rank = generic_gauss_elim_mod(wmat,row,col,md,colstat);          rank = generic_gauss_elim_mod(wmat,row,col,md,colstat);
   
           MKVECT(rnum,rank);
           rnb = (Q *)rnum->body;
           for ( i = 0; i < rank; i++ )
                   for ( j = 0, p = wmat[i]; j < row; j++ )
                           if ( p == row0[j] )
                                   STOQ(j,rnb[i]);
   
         MKMAT(mat,rank,col-rank);          MKMAT(mat,rank,col-rank);
         tmat = (Q **)mat->body;          tmat = (Q **)mat->body;
         for ( i = 0; i < rank; i++ )          for ( i = 0; i < rank; i++ )
Line 924  void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
Line 987  void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
                 } else {                  } else {
                         STOQ(j,cib[l]); l++;                          STOQ(j,cib[l]); l++;
                 }                  }
         n0 = mknode(3,mat,rind,cind);          n0 = mknode(4,mat,rind,cind,rnum);
         MKLIST(*rp,n0);          MKLIST(*rp,n0);
 }  }
   
Line 1199  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
Line 1262  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
                                 } else                                  } else
                                         wi[j] = 0;                                          wi[j] = 0;
   
                   if ( DP_Print ) {
                           fprintf(asir_out,"LU decomposition.."); fflush(asir_out);
                   }
                 rank = find_lhs_and_lu_mod((unsigned int **)w,row,col,md,&rinfo,&cinfo);                  rank = find_lhs_and_lu_mod((unsigned int **)w,row,col,md,&rinfo,&cinfo);
                   if ( DP_Print ) {
                           fprintf(asir_out,"done.\n"); fflush(asir_out);
                   }
                 a = (Q **)almat_pointer(rank,rank); /* lhs mat */                  a = (Q **)almat_pointer(rank,rank); /* lhs mat */
                 MKMAT(bmat,rank,col-rank); b = (Q **)bmat->body; /* lhs mat */                  MKMAT(bmat,rank,col-rank); b = (Q **)bmat->body; /* lhs mat */
                 for ( j = li = ri = 0; j < col; j++ )                  for ( j = li = ri = 0; j < col; j++ )
Line 1236  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
Line 1305  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
                         wx = (int *)MALLOC_ATOMIC(wxsize*sizeof(int));                          wx = (int *)MALLOC_ATOMIC(wxsize*sizeof(int));
                         for ( i = 0; i < wxsize; i++ ) wx[i] = 0;                          for ( i = 0; i < wxsize; i++ ) wx[i] = 0;
                         for ( q = ONE, count = 0; ; ) {                          for ( q = ONE, count = 0; ; ) {
                                 if ( DP_Print > 3 )                                  if ( DP_Print )
                                         fprintf(stderr,"o");                                          fprintf(stderr,"o");
                                 /* wc = -b mod md */                                  /* wc = -b mod md */
                                 get_eg(&tmp0);                                  get_eg(&tmp0);
Legend:
Removed from v.1.44  
changed lines
  Added in v.1.49
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>