[BACK]Return to dist.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2018 / engine

Diff for /OpenXM_contrib2/asir2018/engine/dist.c between version 1.1 and 1.3

version 1.1, 2018/09/19 05:45:07 version 1.3, 2019/08/21 00:37:47
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: OpenXM_contrib2/asir2018/engine/dist.c,v 1.2 2018/09/28 08:20:28 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
   
Line 208  void initd(struct order_spec *spec)
Line 208  void initd(struct order_spec *spec)
   dp_current_spec = spec;    dp_current_spec = spec;
 }  }
   
 int dpm_ispot;  int dpm_ordtype;
   
 /* type=0 => TOP, type=1 => POT */  
 void initdpm(struct order_spec *spec,int type)  
 {  
   int len,i,k,row;  
     Q **mat;  
   
   initd(spec);  
   dpm_ispot = type;  
 }  
   
 void ptod(VL vl,VL dvl,P p,DP *pr)  void ptod(VL vl,VL dvl,P p,DP *pr)
 {  {
   int n,i,j,k;    int n,i,j,k;
Line 263  void ptod(VL vl,VL dvl,P p,DP *pr)
Line 253  void ptod(VL vl,VL dvl,P p,DP *pr)
   
         for ( j = k-1, s = 0; j >= 0; j-- ) {          for ( j = k-1, s = 0; j >= 0; j-- ) {
           ptod(vl,dvl,COEF(w[j]),&t);            ptod(vl,dvl,COEF(w[j]),&t);
           NEWDL(d,n); d->d[i] = QTOS(DEG(w[j]));            NEWDL(d,n); d->d[i] = ZTOS(DEG(w[j]));
           d->td = MUL_WEIGHT(d->d[i],i);            d->td = MUL_WEIGHT(d->d[i],i);
           NEWMP(m); m->dl = d; C(m) = (Obj)ONE; NEXT(m) = 0; MKDP(n,m,u); u->sugar = d->td;            NEWMP(m); m->dl = d; C(m) = (Obj)ONE; NEXT(m) = 0; MKDP(n,m,u); u->sugar = d->td;
           comm_muld(vl,t,u,&r); addd(vl,r,s,&t); s = t;            comm_muld(vl,t,u,&r); addd(vl,r,s,&t); s = t;
Line 305  void dtop(VL vl,VL dvl,DP p,Obj *pr)
Line 295  void dtop(VL vl,VL dvl,DP p,Obj *pr)
       }        }
       for ( i = 0, d = m->dl, tvl = dvl;        for ( i = 0, d = m->dl, tvl = dvl;
         i < n; tvl = NEXT(tvl), i++ ) {          i < n; tvl = NEXT(tvl), i++ ) {
         MKV(tvl->v,r); STOQ(d->d[i],q); pwrp(vl,r,q,(P *)&u);          MKV(tvl->v,r); STOZ(d->d[i],q); pwrp(vl,r,q,(P *)&u);
         arf_mul(vl,t,(Obj)u,&w); t = w;          arf_mul(vl,t,(Obj)u,&w); t = w;
       }        }
       arf_add(vl,s,t,&u); s = u;        arf_add(vl,s,t,&u); s = u;
Line 332  void nodetod(NODE node,DP *dp)
Line 322  void nodetod(NODE node,DP *dp)
     else if ( !NUM(e) || !RATN(e) || !INT(e) )      else if ( !NUM(e) || !RATN(e) || !INT(e) )
       error("nodetod : invalid input");        error("nodetod : invalid input");
     else {      else {
       d->d[i] = QTOS((Q)e); td += MUL_WEIGHT(d->d[i],i);        d->d[i] = ZTOS((Q)e); td += MUL_WEIGHT(d->d[i],i);
     }      }
   }    }
   d->td = td;    d->td = td;
Line 358  void nodetodpm(NODE node,Obj pos,DPM *dp)
Line 348  void nodetodpm(NODE node,Obj pos,DPM *dp)
     else if ( !NUM(e) || !RATN(e) || !INT(e) )      else if ( !NUM(e) || !RATN(e) || !INT(e) )
       error("nodetodpm : invalid input");        error("nodetodpm : invalid input");
     else {      else {
       d->d[i] = QTOS((Q)e); td += MUL_WEIGHT(d->d[i],i);        d->d[i] = ZTOS((Q)e); td += MUL_WEIGHT(d->d[i],i);
     }      }
   }    }
   d->td = td;    d->td = td;
   NEWDMM(m); m->dl = d; m->pos = QTOS((Q)pos); C(m) = (Obj)ONE; NEXT(m) = 0;    NEWDMM(m); m->dl = d; m->pos = ZTOS((Q)pos); C(m) = (Obj)ONE; NEXT(m) = 0;
   MKDPM(len,m,u); u->sugar = td; *dp = u;    MKDPM(len,m,u); u->sugar = td; *dp = u;
 }  }
   
Line 578  void _adddl(int n,DL d1,DL d2,DL d3)
Line 568  void _adddl(int n,DL d1,DL d2,DL d3)
     d3->d[i] = d1->d[i]+d2->d[i];      d3->d[i] = d1->d[i]+d2->d[i];
 }  }
   
   void _addtodl(int n,DL d1,DL d2)
   {
     int i;
   
     d2->td += d1->td;
     for ( i = 0; i < n; i++ )
       d2->d[i] += d1->d[i];
   }
   
   void _copydl(int n,DL d1,DL d2)
   {
     int i;
   
     d2->td = d1->td;
     for ( i = 0; i < n; i++ )
       d2->d[i] = d1->d[i];
   }
   
   int _eqdl(int n,DL d1,DL d2)
   {
     int i;
   
     if ( d2->td != d1->td ) return 0;
     for ( i = 0; i < n; i++ )
       if ( d2->d[i] != d1->d[i] ) return 0;
     return 1;
   }
   
 /* m1 <- m1 U dl*f, destructive */  /* m1 <- m1 U dl*f, destructive */
   
 NODE mul_dllist(DL dl,DP f);  NODE mul_dllist(DL dl,DP f);
Line 942  void actm(VL vl,int nv,MP m1,MP m2,DP *pr)
Line 960  void actm(VL vl,int nv,MP m1,MP m2,DP *pr)
   c = ONE;    c = ONE;
   for ( i = 0; i < nv; i++ ) {    for ( i = 0; i < nv; i++ ) {
     for ( j = d2->d[i], k = d1->d[i]; k > 0; k--, j-- ) {      for ( j = d2->d[i], k = d1->d[i]; k > 0; k--, j-- ) {
       STOQ(j,jq); mulz(c,jq,&c1); c = c1;        STOZ(j,jq); mulz(c,jq,&c1); c = c1;
     }      }
     d->d[i] = d2->d[i]-d1->d[i];      d->d[i] = d2->d[i]-d1->d[i];
   }    }
Line 2364  void pwrnbp(VL vl,NBP a,Z q,NBP *c)
Line 2382  void pwrnbp(VL vl,NBP a,Z q,NBP *c)
   else if ( UNIQ(q) )    else if ( UNIQ(q) )
     *c = a;      *c = a;
   else {    else {
     STOQ(2,two);      STOZ(2,two);
     divqrz(q,two,&q1,&r1);      divqrz(q,two,&q1,&r1);
     pwrnbp(vl,a,q1,&a1);      pwrnbp(vl,a,q1,&a1);
     mulnbp(vl,a1,a1,&a2);      mulnbp(vl,a1,a1,&a2);
Line 2616  NBP harmonic_mul_nbm(NBM a,NBM b)
Line 2634  NBP harmonic_mul_nbm(NBM a,NBM b)
   
 /* DPM functions */  /* DPM functions */
   
   DMMstack dmm_stack;
   
   // data=[Ink,...,In0,Base]
   // Ini = a list of module monomials
   // Base=an order spec for polynomial ring or module
   void set_schreyer_order(NODE data)
   {
     DMMstack t;
     int len,i;
     NODE in;
     struct order_spec *base;
   
     if ( !data ) {
       dmm_stack = 0;
       if ( dp_current_spec && dp_current_spec->id >= 256 )
         dpm_ordtype = dp_current_spec->ispot;
       else
         dpm_ordtype = 0;
       return;
     } else if ( NEXT(data) == 0 ) {
       create_order_spec(0,BDY(data),&base);
       NEWDMMstack(t);
       t->in = 0;
       t->rank = 0;
       t->ordtype = base->ispot;
       t->next = 0;
       dmm_stack = t;
       dpm_ordtype = 2;
     } else {
       set_schreyer_order(NEXT(data));
       in = BDY((LIST)BDY(data));
       len = length(in);
       NEWDMMstack(t);
       t->in = 0;
       t->rank = len;
       t->in = (DMM *)MALLOC((len+1)*sizeof(DMM));
       t->ordtype = 0;
       t->next = dmm_stack;
       dmm_stack = t;
       for ( i = 1; i <= len; i++, in = NEXT(in) ) {
         t->in[i] = BDY((DPM)BDY(in));
       }
     }
   }
   
   int compdmm_schreyer(int n,DMM m1,DMM m2)
   {
      DL d1,d2;
      int pos1,pos2,t;
      DMM *in;
      DMMstack s;
   
      NEWDL(d1,n); _copydl(n,m1->dl,d1); pos1 = m1->pos;
      NEWDL(d2,n); _copydl(n,m2->dl,d2); pos2 = m2->pos;
      for ( s = dmm_stack; s->in; s = NEXT(s) ) {
        in = s->in;
        _addtodl(n,in[pos1]->dl,d1);
        _addtodl(n,in[pos2]->dl,d2);
        if ( _eqdl(n,d1,d2) && in[pos1]->pos == in[pos2]->pos ) {
          if ( pos1 < pos2 ) return 1;
          else if ( pos1 > pos2 ) return -1;
          else return 0;
        }
        pos1 = in[pos1]->pos;
        pos2 = in[pos2]->pos;
      }
      // comparison by the bottom order
     if ( s->ordtype == 1 ) {
       if ( pos1 < pos2 ) return 1;
       else if ( pos1 > pos2 ) return -1;
       else return (*cmpdl)(n,d1,d2);
     } else {
       t = (*cmpdl)(n,d1,d2);
       if ( t ) return t;
       else if ( pos1 < pos2 ) return 1;
       else if ( pos1 > pos2 ) return -1;
       else return 0;
     }
   }
   
 int compdmm(int n,DMM m1,DMM m2)  int compdmm(int n,DMM m1,DMM m2)
 {  {
   int t;    int t;
   
   if ( dpm_ispot ) {    if ( dpm_ordtype == 1 ) {
     if ( m1->pos < m2->pos ) return 1;      if ( m1->pos < m2->pos ) return 1;
     else if ( m1->pos > m2->pos ) return -1;      else if ( m1->pos > m2->pos ) return -1;
     else return (*cmpdl)(n,m1->dl,m2->dl);      else return (*cmpdl)(n,m1->dl,m2->dl);
   } else {    } else if ( dpm_ordtype == 0 ) {
     t = (*cmpdl)(n,m1->dl,m2->dl);      t = (*cmpdl)(n,m1->dl,m2->dl);
     if ( t ) return t;      if ( t ) return t;
     else if ( m1->pos < m2->pos ) return 1;      else if ( m1->pos < m2->pos ) return 1;
     else if ( m1->pos > m2->pos ) return -1;      else if ( m1->pos > m2->pos ) return -1;
     else return 0;      else return 0;
     } else if ( dpm_ordtype == 2 ) {
       return compdmm_schreyer(n,m1,m2);
   }    }
 }  }
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>