Mercurial > hg > jgplsrc

annotate vt.c @ 0:e0bbaa717f41 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
lol J
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500 (2013-11-25)
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
1 /* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
2 /* License in license.txt. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
3 /* */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
4 /* Verbs: Take and Drop */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
5
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
6 #include "j.h"
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
7
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
8
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
9 F1(jtbehead ){R drop(one, w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10 F1(jtcurtail){R drop(num[-1],w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 F1(jtshift1){R drop(num[-1],over(one,w));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 static A jttk0(J jt,B b,A a,A w){A z;I k,m=0,n,p,r,*s,*u;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 r=AR(w); n=AN(a); u=AV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16 if(!b){RE(m=prod(n,u)); ASSERT(m>IMIN,EVLIMIT); RE(m=mult(ABS(m),prod(r-n,n+AS(w))));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 GA(z,AT(w),m,r,AS(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18 s=AS(z); DO(n, p=u[i]; ASSERT(p>IMIN,EVLIMIT); *s++=ABS(p););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 if(m){k=bp(AT(w)); mvc(k*m,AV(z),k,jt->fillv);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 static F2(jttks){PROLOG;A a1,q,x,y,z;B b,c;I an,m,r,*s,*u,*v;P*wp,*zp;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 an=AN(a); u=AV(a); r=AR(w); s=AS(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 GA(z,AT(w),1,r,s); v=AS(z); DO(an, v[i]=ABS(u[i]););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 zp=PAV(z); wp=PAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 if(an<=r){RZ(a=vec(INT,r,s)); ICPY(AV(a),u,an);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 a1=SPA(wp,a); RZ(q=paxis(r,a1)); m=AN(a1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 RZ(a=from(q,a )); u=AV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 RZ(y=from(q,shape(w))); s=AV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 b=0; DO(r-m, if(b=u[i+m]!=s[i+m])break;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 c=0; DO(m, if(c=u[i ]!=s[i ])break;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 if(b){jt->fill=SPA(wp,e); x=irs2(vec(INT,r-m,m+u),SPA(wp,x),0L,1L,-1L,jttake); jt->fill=0; RZ(x);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34 else x=SPA(wp,x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 if(c){A j;C*xv,*yv;I d,i,*iv,*jv,k,n,t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 d=0; t=AT(x); k=bp(t)*aii(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 q=SPA(wp,i); n=IC(q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 GA(j,INT,AN(q),AR(q),AS(q)); jv= AV(j); iv= AV(q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 GA(y,t, AN(x),AR(x),AS(x)); yv=CAV(y); xv=CAV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 for(i=0;i<n;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 c=0; DO(m, t=u[i]; if(c=0>t?iv[i]<t+s[i]:iv[i]>=t)break;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 if(!c){++d; MC(yv,xv,k); yv+=k; DO(m, t=u[i]; *jv++=0>t?iv[i]-(t+s[i]):iv[i];);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 iv+=m; xv+=k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 SPB(zp,i,d<n?take(sc(d),j):j); SPB(zp,x,d<n?take(sc(d),y):y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 }else{SPB(zp,i,ca(SPA(wp,i))); SPB(zp,x,b?x:ca(x));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 SPB(zp,a,ca(SPA(wp,a)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 SPB(zp,e,ca(SPA(wp,e)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 EPILOG(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 } /* take on sparse array w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52 static F2(jttk){PROLOG;A y,z;B b=0;C*yv,*zv;I c,d,dy,dz,e,i,k,m,n,p,q,r,*s,t,*u;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 n=AN(a); u=AV(a); r=AR(w); s=AS(w); t=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 if(t&SPARSE)R tks(a,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 DO(n, if(!u[i]){b=1; break;}); if(!b)DO(r-n, if(!s[n+i]){b=1; break;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 if(b||!AN(w))R tk0(b,a,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 k=bp(t); z=w; c=q=1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 for(i=0;i<n;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 c*=q; p=u[i]; q=ABS(p); m=s[i];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 if(q!=m){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 RE(d=mult(AN(z)/m,q)); GA(y,t,d,r,AS(z)); *(i+AS(y))=q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 if(q>m)mvc(k*AN(y),CAV(y),k,jt->fillv);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 d=AN(z)/(m*c)*k; e=d*MIN(m,q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 dy=d*q; yv=CAV(y); if(0>p&&q>m)yv+=d*(q-m);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 dz=d*m; zv=CAV(z); if(0>p&&m>q)zv+=d*(m-q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 DO(c, MC(yv,zv,e); yv+=dy; zv+=dz;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 b=1; z=y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69 if(!b)z=ca(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 EPILOG(RELOCATE(w,z));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 F2(jttake){A s,t;D*av,d;I acr,af,ar,n,*tv,*v,wcr,wf,wr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 if(SPARSE&AT(a))RZ(a=denseit(a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 if(!(SPARSE&AT(w)))RZ(w=setfv(w,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 ar=AR(a); acr=jt->rank?jt->rank[0]:ar; af=ar-acr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78 wr=AR(w); wcr=jt->rank?jt->rank[1]:wr; wf=wr-wcr; jt->rank=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 if(af||1<acr)R rank2ex(a,w,0L,af?acr:1L,wcr,jttake);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 n=AN(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 ASSERT(!wcr||n<=wcr,EVLENGTH);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 if(AT(a)&B01+INT)RZ(s=a=vi(a))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 RZ(t=vib(a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85 if(!(AT(a)&FL))RZ(a=cvt(FL,a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 av=DAV(a); tv=AV(t); v=wf+AS(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 DO(n, d=av[i]; if(d==IMIN)tv[i]=(I)d; else if(INF(d))tv[i]=wcr?v[i]:1;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 s=a=t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 if(!wcr||wf){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 RZ(s=vec(INT,wf+n,AS(w))); v=wf+AV(s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 if(!wcr){DO(n,v[i]=1;); RZ(w=reshape(s,w));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 ICPY(v,AV(a),n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 R tk(s,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 F2(jtdrop){A s;I acr,af,ar,d,m,n,*u,*v,wcr,wf,wr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 RZ((a=vib(a))&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 ar=AR(a); acr=jt->rank?jt->rank[0]:ar; af=ar-acr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 wr=AR(w); wcr=jt->rank?jt->rank[1]:wr; wf=wr-wcr; jt->rank=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 if(af||1<acr)R rank2ex(a,w,0L,af?acr:1L,wcr,jtdrop);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 n=AN(a); u=AV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 ASSERT(!wcr||n<=wcr,EVLENGTH);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 if(wcr){RZ(s=shape(w)); v=wf+AV(s); DO(n, d=u[i]; m=v[i]; v[i]=d<-m?0:d<0?d+m:d<m?d-m:0;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 else{GA(s,INT,wr+n,1,0); v=AV(s); ICPY(v,AS(w),wf); v+=wf; DO(n, v[i]=!u[i];); RZ(w=reshape(s,w));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 R tk(s,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 static F1(jtrsh0){A x,y;I wcr,wf,wr,*ws;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 wr=AR(w); wcr=jt->rank?jt->rank[1]:wr; wf=wr-wcr; jt->rank=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 ws=AS(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 RZ(x=vec(INT,wr-1,ws)); ICPY(wf+AV(x),ws+wf+1,wcr-1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 RZ(w=setfv(w,w)); GA(y,AT(w),1,0,0); MC(AV(y),jt->fillv,bp(AT(w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 R reshape(x,y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 F1(jthead){I wcr,wf,wr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 wr=AR(w); wcr=jt->rank?jt->rank[1]:wr; wf=wr-wcr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 R !wcr||*(wf+AS(w))? from(num[ 0],w) :
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 SPARSE&AT(w)?irs2(num[0],take(num[ 1],w),0L,0L,wcr,jtfrom):rsh0(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 F1(jttail){I wcr,wf,wr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 wr=AR(w); wcr=jt->rank?jt->rank[1]:wr; wf=wr-wcr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 R !wcr||*(wf+AS(w))?from(num[-1],w) :
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 SPARSE&AT(w)?irs2(num[0],take(num[-1],w),0L,0L,wcr,jtfrom):rsh0(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 }