예제 #1
0
파일: vrep.c 프로젝트: iocane/unbox
static REPF(jtrepzsx) {
    A q,x,y;
    I c,d,j,k=-1,m,p=0,*qv,*xv,*yv;
    P*ap;
    RZ(a&&w);
    ap=PAV(a);
    x=SPA(ap,x);
    m=AN(x);
    if(!AN(SPA(ap,a)))R repzdx(ravel(x),w,wf,wcr);
    y=SPA(ap,i);
    yv=AV(y);
    RZ(x=cvt(INT,vec(FL,2*m,AV(x))));
    xv=AV(x);
    if(equ(zero,SPA(ap,e))) {
        k=c=*(wf+AS(w));
        if(!wf&&SPARSE&AT(w)) {
            A a,y;
            I m,n,q,*v;
            P*wp;
            wp=PAV(w);
            a=SPA(wp,a);
            if(AN(a)&&!*AV(a)) {
                y=SPA(wp,i);
                v=AS(y);
                m=v[0];
                n=v[1];
                v=AV(y);
                k=m?v[(m-1)*n]+1:0;
                q=0;
                DO(m, if(q==*v)++q; else if(q<*v) {
                    k=q;
                    break;
                }
            v+=n;);
            }
예제 #2
0
파일: vcant.c 프로젝트: EdKeith/core
static A jtcants(J jt,A a,A w,A z){A a1,q,y;B*b,*c;I*u,wr,zr;P*wp,*zp;
 RZ(a&&w&&z);
 RZ(a=grade1(a));
 wr=AR(w); wp=PAV(w); a1=SPA(wp,a);
 zr=AR(z); zp=PAV(z);
 ASSERT(wr==zr,EVNONCE);
 RZ(b=bfi(wr,a1,1));
 GA(q,B01,wr,1,0); c=BAV(q); u=AV(a); DO(wr, c[i]=b[u[i]];);
예제 #3
0
파일: cpdtsp.c 프로젝트: mlochbaum/jsource
static F2(jtpdtspvv){A x;D*av,s,t,*wv,z;I i,*u,*u0,*uu,*v,*v0,*vv;P*ap,*wp;
 RZ(a&&w);
 ap=PAV(a); x=SPA(ap,i); u=u0=AV(x); uu=u+AN(x); x=SPA(ap,x); av=DAV(x);
 wp=PAV(w); x=SPA(wp,i); v=v0=AV(x); vv=v+AN(x); x=SPA(wp,x); wv=DAV(x);
 z=0.0;
 NAN0;
 while(1){
  i=*u; while(i>*v&&v<vv)++v; if(v==vv)break;
  if(i==*v){s=av[u-u0]; t=wv[v-v0]; z+=s&&t?s*t:0; ++u; ++v; continue;}
  i=*v; while(i>*u&&u<uu)++u; if(u==uu)break;
  if(i==*u){s=av[u-u0]; t=wv[v-v0]; z+=s&&t?s*t:0; ++u; ++v; continue;}
 }
 NAN1;
 R scf(z);
}
예제 #4
0
파일: cpdtsp.c 프로젝트: mlochbaum/jsource
static F2(jtpdtspmv){A ax,b,g,x,wx,y,yi,yj,z;B*bv;I m,n,s[2],*u,*v,*yv;P*ap,*wp,*zp;
 RZ(a&&w);
 ap=PAV(a); y=SPA(ap,i); yv=AV(y); s[0]=n=*AS(y); s[1]=1;
 GATV(yj,INT,n,2,s);
 if(DENSE&AT(w)){
  GATV(yi,INT,n,2,s); u=AV(yi); AR(yj)=1; v=AV(yj);
  DO(n, *u++=*yv++; *v++=*yv++;);
예제 #5
0
파일: vgsp.c 프로젝트: PlanetAPL/j-language
static B jtspsscell(J jt,A w,I wf,I wcr,A*zc,A*zt){A c,t,y;B b;
     I cn,*cv,j,k,m,n,p,*s,tn,*tv,*u,*u0,*v,*v0;P*wp;
 wp=PAV(w); s=AS(w); p=3+s[wf];
 y=SPA(wp,i); s=AS(y); m=s[0]; n=s[1];
 u0=AV(y); u=u0+n; 
 v0=u0+wf; v=v0+n;
 if(!m){*zt=*zc=mtv; R 1;}
 GATV(t,INT,2+2*m,1,0); tv=AV(t); tv[0]=tv[1]=0; tn=2;
 GATV(c,INT,  2*m,2,0); cv=AV(c); cv[0]=0;       cn=0; *(1+AS(c))=2;
 for(j=1;j<m;++j){
  b=1;
  for(k=0;k<wf;++k)
   if(u0[k]!=u[k]){
    tv[tn++]=j; tv[tn++]=j; cv[1+cn]=tn-cv[cn];
    if(p==tn-cv[cn]){++cv[cn]; cv[1+cn]-=2;} 
    cn+=2;
    cv[cn]=tn-2; u0=u; v0=v; b=0;
    break;
   }
  if(b&&*v0!=*v){tv[tn++]=j; v0=v;}
  u+=n; v+=n;
 }
 tv[tn++]=m; tv[tn++]=m; cv[1+cn]=tn-cv[cn];
 if(p==tn-cv[cn]){++cv[cn]; cv[1+cn]-=2;}
 cn+=2;
 AN(t)=    *AS(t)=tn;   *zt=t;  /* cell divisions (row indices in y)            */
 AN(c)=cn; *AS(c)=cn/2; *zc=c;  /* item divisions (indices in t, # of elements) */
 R 1;
}    /* frame: all sparse; cell: 1 or more sparse, then dense */
예제 #6
0
파일: vrep.c 프로젝트: adrian17/jsource
static REPF(jtrepzdx){A p,q,x;P*wp;
 RZ(a&&w);
 if(SPARSE&AT(w)){wp=PAV(w); x=SPA(wp,e);}
 else x=jt->fill&&AN(jt->fill)?jt->fill:filler(w);
 RZ(p=repeat(ravel(rect(a)),ravel(stitch(IX(wcr?*(wf+AS(w)):1),num[-1]))));
 RZ(q=irs2(w,x,0L,wcr,0L,jtover));
 R irs2(p,q,0L,1L,wcr+!wcr,jtfrom);
}    /* (dense complex) # (dense or sparse) */
예제 #7
0
SEXP isoreg(SEXP y)
{
    int n = LENGTH(y), i, ip, known, n_ip;
    double tmp, slope;
    SEXP yc, yf, iKnots, ans;
    const char *anms[] = {"y", "yf", ""};
    
    double *yPAV;

    /* unneeded: y = coerceVector(y, REALSXP); */

    PROTECT(ans = mkNamed(VECSXP, anms));

    SET_VECTOR_ELT(ans, 0, y);
    SET_VECTOR_ELT(ans, 1, yf = allocVector(REALSXP, n));
    
    PAV(REAL(y), n, REAL(yf));
    
    
    
    
    UNPROTECT(1);
    return(ans);
}