/
v.c
119 lines (104 loc) · 4.12 KB
/
v.c
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */
/* License in license.txt. */
/* */
/* Verbs */
#include "j.h"
F1(jttally ){A z; RZ(w); z=sc(IC(w)); R AT(w)&XNUM+RAT?xco1(z):z;}
F1(jtshapex){A z; RZ(w); z=vec(INT,AR(w),AS(w)); R AT(w)&XNUM+RAT?xco1(z):z;}
F1(jtshape ){RZ(w); R vec(INT,AR(w),AS(w));}
F1(jtravel){A a,c,q,x,y,y0,z;B*b,d;I f,j,m,n,r,*u,*v,wr,*ws,wt,*yv;P*wp,*zp;
RZ(w);
n=AN(w); ws=AS(w); wt=AT(w); d=!(wt&SPARSE);
wr=AR(w); r=jt->rank?jt->rank[1]:wr; f=wr-r; jt->rank=0;
RE(m=prod(r,f+ws));
GA(z,wt,d?n:1,1+f,ws); *(f+AS(z))=m;
if(d){MC(AV(z),AV(w),n*bp(wt)); R RELOCATE(w,z);}
wp=PAV(w); zp=PAV(z);
RZ(b=bfi(wr,SPA(wp,a),1));
if(memchr(b+f,C1,r)){
if(memchr(b+f,C0,r)){memset(b+f,C1,r); RZ(w=reaxis(ifb(wr,b),w)); wp=PAV(w); x=SPA(wp,x);}
else RZ(x=ca(SPA(wp,x)));
RZ(a=ifb(1+f,b));
GA(c,INT,r,1L,0L); v=r+AV(c); j=wr; m=1; DO(r, *--v=m; m*=ws[--j];);
y0=SPA(wp,i); v=AS(y0); m=v[0]; n=v[1];
RZ(q=pdt(dropr(n-r,y0),c));
GA(y,INT,m*(1+n-r),2,0); v=AS(y); v[0]=m; v[1]=1+n-r;
yv=AV(y); u=AV(y0); v=AV(q); j=n-r;
DO(m, ICPY(yv,u,j); yv[j]=*v++; yv+=1+j; u+=n;);
}else{RZ(a=ca(SPA(wp,a))); RZ(x=irs1(SPA(wp,x),0L,r,jtravel)); RZ(y=ca(SPA(wp,i)));}
SPB(zp,a,a);
SPB(zp,e,ca(SPA(wp,e)));
SPB(zp,x,x);
SPB(zp,i,y);
R z;
}
F1(jttable){A z;I f,r,*s,wr,*ws,wt;
RZ(w);
wt=AT(w); ws=AS(w); wr=AR(w); r=jt->rank?jt->rank[1]:wr; f=wr-r; jt->rank=0;
if(wt&SPARSE){z=irs1(w,0L,r?r-1:0,jtravel); R r?z:irs1(z,0L,0L,jtravel);}
GA(z,wt,AN(w),2+f,ws); s=f+AS(z);
if(r)*(1+s)=prod(r-1,1+f+ws); else *s=*(1+s)=1;
MC(AV(z),AV(w),AN(w)*bp(wt));
R RELOCATE(w,z);
}
static A jtlr2(J jt,B left,A a,A w){A z;C*v;I acr,af,ar,*as,c,f,k,n,r,*s,t,
wcr,wf,wr,*ws,zn;
RZ(a&&w);
ar=AR(a); acr=jt->rank?jt->rank[0]:ar; af=ar-acr; as=AS(a);
wr=AR(w); wcr=jt->rank?jt->rank[1]:wr; wf=wr-wcr; ws=AS(w);
if(left){if(af>=wf)R rat(a); r=acr; s=af+as; t=AT(a); v=CAV(a); n=AN(a);}
else {if(wf>=af)R rat(w); r=wcr; s=wf+ws; t=AT(w); v=CAV(w); n=AN(w);}
RE(c=af?prod(f=af,as):prod(f=wf,ws)); RE(zn=mult(c,prod(r,s)));
GA(z,t,zn,f+r,af?as:ws); ICPY(f+AS(z),s,r);
k=bp(t); mvc(k*zn,AV(z),k*n,v);
R z;
}
F2(jtleft2 ){R lr2(1,a,w);}
F2(jtright2){R lr2(0,a,w);}
F1(jtright1){R rat(w);}
F1(jtiota){A z;I m,n,*v;
F1RANK(1,jtiota,0);
if(AT(w)&XNUM+RAT)R cvt(XNUM,iota(vi(w)));
RZ(w=vi(w)); n=AN(w); v=AV(w);
if(1==n){m=*v; R 0>m?apv(-m,-m-1,-1L):IX(m);}
RE(m=prod(n,v)); z=reshape(mag(w),IX(ABS(m)));
DO(n, if(0>v[i])z=irs1(z,0L,n-i,jtreverse););
R z;
}
F1(jtjico1){A y,z;B b;D d,*v;I c,m,n;
F1RANK(0,jtjico1,0);
RZ(y=cvt(FL,rect(w))); v=DAV(y); d=*v;
RE(m=v[1]?i0(cvt(INT,tail(y))):i0(tymes(mag(w),num[2])));
ASSERT(0<m||!m&&0==d,EVDOMAIN);
n=(I)jfloor(d+0.1); b=FEQ(d,n); c=(2*ABS(n))/(m?m:1);
if(b&&m*c==2*ABS(n))z=apv(1+m,-n,0>d?-c:c);
else z=plus(scf(0>d?d:-d),tymes(scf(2*ABS(d)/m),apv(1+m,0>d?m:0L,0>d?-1L:1L)));
if(AT(w)&XNUM+RAT)z=cvt(AT(w)&XNUM||equ(w,floor1(w))?XNUM:RAT,z);
R z;
}
DF1(jtnum1){RZ( w&&self); R VAV(self)->h;}
DF2(jtnum2){RZ(a&&w&&self); R VAV(self)->h;}
F2(jtfromr ){R irs2(a,w,0L,RMAX,1L,jtfrom );}
F2(jtrepeatr){R irs2(a,w,0L,RMAX,1L,jtrepeat);}
A jttaker(J jt,I n,A w){R irs2(sc(n),w,0L,RMAX,1L,jttake);}
A jtdropr(J jt,I n,A w){R irs2(sc(n),w,0L,RMAX,1L,jtdrop);}
F1(jticap){A a,e;I n;P*p;
F1RANK(1,jticap,0);
n=IC(w);
if(SB01&AT(w)){
p=PAV(w); a=SPA(p,a); e=SPA(p,e);
R *BAV(e)||equ(mtv,a) ? repeat(w,IX(n)) : repeat(SPA(p,x),ravel(SPA(p,i)));
}
R B01&AT(w) ? ifb(n,BAV(w)) : repeat(w,IX(n));
}
A jtcharmap(J jt,A w,A x,A y){A z;B bb[256];I k,n,wn;UC c,*u,*v,zz[256];
RZ(w&&x&&y);
if(!(LIT&AT(w)))R from(indexof(x,w),y);
wn=AN(w); n=MIN(AN(x),AN(y)); u=n+UAV(x); v=n+UAV(y);
k=256; memset(bb,C0,256); if(n<AN(y))memset(zz,*(n+UAV(y)),256);
DO(n, c=*--u; zz[c]=*--v; if(!bb[c]){--k; bb[c]=1;});
GA(z,LIT,wn,AR(w),AS(w)); v=UAV(z); u=UAV(w);
if(k&&n==AN(y))DO(wn, c=*u++; ASSERT(bb[c],EVINDEX); *v++=zz[c];)
else if(!bitwisecharamp(zz,wn,u,v))DO(wn, *v++=zz[*u++];);
R z;
} /* y {~ x i. w */