[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.42 and 1.49

version 1.42, 2004/12/13 23:04:16 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.41 2004/12/04 09:39:27 noro 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 760  void Psize(NODE arg,LIST *rp)
Line 792  void Psize(NODE arg,LIST *rp)
                                 n = ((MAT)ARG0(arg))->row; m = ((MAT)ARG0(arg))->col;                                  n = ((MAT)ARG0(arg))->row; m = ((MAT)ARG0(arg))->col;
                                 STOQ(m,q); MKNODE(s,q,0); STOQ(n,q); MKNODE(t,q,s);                                  STOQ(m,q); MKNODE(s,q,0); STOQ(n,q); MKNODE(t,q,s);
                                 break;                                  break;
                           case O_IMAT:
                                   n = ((IMAT)ARG0(arg))->row; m = ((IMAT)ARG0(arg))->col;
                                   STOQ(m,q); MKNODE(s,q,0); STOQ(n,q); MKNODE(t,q,s);
                                   break;
                         default:                          default:
                                 error("size : invalid argument"); break;                                  error("size : invalid argument"); break;
                 }                  }
Line 828  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 871  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 878  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 891  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 903  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 920  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 1174  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
Line 1241  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
         int ret;          int ret;
         struct oEGT eg_mul,eg_inv,eg_intrat,eg_check,tmp0,tmp1;          struct oEGT eg_mul,eg_inv,eg_intrat,eg_check,tmp0,tmp1;
         int period;          int period;
           int *wx,*ptr;
           int wxsize,nsize;
           N wn;
           Q wq;
   
         a0 = (Q **)mat->body;          a0 = (Q **)mat->body;
         row = mat->row; col = mat->col;          row = mat->row; col = mat->col;
Line 1191  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 1223  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
Line 1300  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
                         init_eg(&eg_mul); init_eg(&eg_inv);                          init_eg(&eg_mul); init_eg(&eg_inv);
                         init_eg(&eg_check); init_eg(&eg_intrat);                          init_eg(&eg_check); init_eg(&eg_intrat);
                         period = F4_INTRAT_PERIOD;                          period = F4_INTRAT_PERIOD;
                         for ( q = ONE, count = 0; ; count++ ) {                          nsize = period;
                                 if ( DP_Print > 3 )                          wxsize = rank*ri*nsize;
                           wx = (int *)MALLOC_ATOMIC(wxsize*sizeof(int));
                           for ( i = 0; i < wxsize; i++ ) wx[i] = 0;
                           for ( q = ONE, count = 0; ; ) {
                                   if ( DP_Print )
                                         fprintf(stderr,"o");                                          fprintf(stderr,"o");
                                 /* wc = -b mod md */                                  /* wc = -b mod md */
                                   get_eg(&tmp0);
                                 for ( i = 0; i < rank; i++ )                                  for ( i = 0; i < rank; i++ )
                                         for ( j = 0, bi = b[i], wi = wc[i]; j < ri; j++ )                                          for ( j = 0, bi = b[i], wi = wc[i]; j < ri; j++ )
                                                 if ( u = (Q)bi[j] ) {                                                  if ( u = (Q)bi[j] ) {
Line 1236  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
Line 1318  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
                                                         wi[j] = t;                                                          wi[j] = t;
                                                 } else                                                  } else
                                                         wi[j] = 0;                                                          wi[j] = 0;
                                 /* wc = A^(-1)wc; wc is normalized */                                  /* wc = A^(-1)wc; wc is not normalized */
                                 get_eg(&tmp0);                                  solve_by_lu_mod(w,rank,md,wc,ri,0);
                                 solve_by_lu_mod(w,rank,md,wc,ri);                                  /* wx += q*wc */
                                 get_eg(&tmp1);                                  ptr = wx;
                                 add_eg(&eg_inv,&tmp0,&tmp1);  
                                 /* x = x-q*wc */  
                                 for ( i = 0; i < rank; i++ )                                  for ( i = 0; i < rank; i++ )
                                         for ( j = 0, xi = x[i], wi = wc[i]; j < ri; j++ ) {                                          for ( j = 0, wi = wc[i]; j < ri; j++ ) {
                                                 STOQ(wi[j],u); mulq(q,u,&s);                                                  if ( wi[j] )
                                                 subq(xi[j],s,&u); xi[j] = u;                                                          muln_1(BD(NM(q)),PL(NM(q)),wi[j],ptr);
                                                   ptr += nsize;
                                         }                                          }
                                   count++;
                                   get_eg(&tmp1);
                                   add_eg(&eg_inv,&tmp0,&tmp1);
                                 get_eg(&tmp0);                                  get_eg(&tmp0);
                                 for ( i = 0; i < rank; i++ )                                  for ( i = 0; i < rank; i++ )
                                         for ( j = 0; j < ri; j++ ) {                                          for ( j = 0; j < ri; j++ ) {
Line 1264  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
Line 1348  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
                                 add_eg(&eg_mul,&tmp0,&tmp1);                                  add_eg(&eg_mul,&tmp0,&tmp1);
                                 /* q = q*md */                                  /* q = q*md */
                                 mulq(q,mdq,&u); q = u;                                  mulq(q,mdq,&u); q = u;
                                 if ( !(count % period) ) {                                  if ( count == period ) {
                                         get_eg(&tmp0);                                          get_eg(&tmp0);
                                           ptr = wx;
                                           for ( i = 0; i < rank; i++ )
                                                   for ( j = 0, xi = x[i]; j < ri;
                                                           j++, ptr += nsize ) {
                                                           for ( k = nsize-1; k >= 0 && !ptr[k]; k-- );
                                                           if ( k >= 0 ) {
                                                                   wn = NALLOC(k+1);
                                                                   PL(wn) = k+1;
                                                                   for ( l = 0; l <= k; l++ ) BD(wn)[l] = (unsigned int)ptr[l];
                                                                   NTOQ(wn,1,wq);
                                                                   subq(xi[j],wq,&u); xi[j] = u;
                                                           }
                                                   }
                                         ret = intmtoratm_q(xmat,NM(q),*nmmat,dn);                                          ret = intmtoratm_q(xmat,NM(q),*nmmat,dn);
                                         get_eg(&tmp1); add_eg(&eg_intrat,&tmp0,&tmp1);                                          get_eg(&tmp1); add_eg(&eg_intrat,&tmp0,&tmp1);
                                         if ( ret ) {                                          if ( ret ) {
Line 1288  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
Line 1385  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
                                                         }                                                          }
                                                         return rank;                                                          return rank;
                                                 }                                                  }
                                         } else                                          } else {
                                                 period *=2;                                                  period = period*3/2;
                                                   count = 0;
                                                   nsize += period;
                                                   wxsize += rank*ri*nsize;
                                                   wx = (int *)REALLOC(wx,wxsize*sizeof(int));
                                                   for ( i = 0; i < wxsize; i++ ) wx[i] = 0;
                                           }
                                 }                                  }
                         }                          }
         }          }
Line 1890  int find_lhs_and_lu_mod(unsigned int **a,int row,int c
Line 1993  int find_lhs_and_lu_mod(unsigned int **a,int row,int c
         b = a^(-1)b          b = a^(-1)b
  */   */
   
 void solve_by_lu_mod(int **a,int n,int md,int **b,int l)  void solve_by_lu_mod(int **a,int n,int md,int **b,int l,int normalize)
 {  {
         unsigned int *y,*c;          unsigned int *y,*c;
         int i,j,k;          int i,j,k;
Line 1923  void solve_by_lu_mod(int **a,int n,int md,int **b,int 
Line 2026  void solve_by_lu_mod(int **a,int n,int md,int **b,int 
                         DMAR(t,a[i][i],0,md,c[i])                          DMAR(t,a[i][i],0,md,c[i])
                 }                  }
                 /* copy c to b[.][k] with normalization */                  /* copy c to b[.][k] with normalization */
                 for ( i = 0; i < n; i++ )                  if ( normalize )
                         b[i][k] = (int)(c[i]>m2 ? c[i]-md : c[i]);                          for ( i = 0; i < n; i++ )
                                   b[i][k] = (int)(c[i]>m2 ? c[i]-md : c[i]);
                   else
                           for ( i = 0; i < n; i++ )
                                   b[i][k] = c[i];
         }          }
 }  }
   
Legend:
Removed from v.1.42  
changed lines
  Added in v.1.49
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>