Mercurial > hg > jgplsrc

annotate visp.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
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: Index-of on Sparse Arrays */
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 static I jtioev(J jt,I mode,A a){A ae,ax,ay,p;B*pv;I j,k,m,n,*yv;P*ap;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10 ap=PAV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11 ae=SPA(ap,e);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 ay=SPA(ap,i); yv=AV(ay);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 ax=SPA(ap,x); m=k=AN(ax); n=j=*AS(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 RZ(p=eq(ax,ae)); pv=BAV(p);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 switch((AN(ay)?2:0)+(1==mode)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16 case 0: DO(m, if( pv[i])R i;); R m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 case 1: DO(m, --k; if( pv[k])R k;); R n-!m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18 case 2: DO(m, if(i!=yv[i]||pv[i])R i;); R m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 default: DO(m, --j; --k; if(j!=yv[k]||pv[k])R j;); R m==n?n:n-m-1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 }} /* index of sparse element */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 A jtiovxs(J jt,I mode,A a,A w){A e,x,z;B h;I at,t,wt;P*ap=0,*wp,*zp;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 at=AT(a); if(SPARSE&at){at=DTYPE(at); ap=PAV(a);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 wt=DTYPE(AT(w)); wp=PAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 if(h=HOMO(at,wt))t=maxtype(at,wt);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 GA(z,SINT,1L,AR(w),AS(w)); zp=PAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 SPB(zp,a,SPA(wp,a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 SPB(zp,i,SPA(wp,i));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 e=SPA(wp,e); if(h&&t!=wt)RZ(e=cvt(t,e));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 x=SPA(wp,x); if(h&&t!=wt)RZ(x=cvt(t,x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 if(ap){A ae,ax,ay,p,q;B b=0,*pv;I j,k,m,n,*v,*yv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 ay=SPA(ap,i); yv=AV(ay);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 ae=SPA(ap,e); if(h&&t!=at)RZ(ae=cvt(t,ae));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34 ax=SPA(ap,x); if(h&&t!=at)RZ(ax=cvt(t,ax)); if(!AN(ay))RZ(ax=ravel(ax));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 m=AN(ax); n=*AS(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 j=ioev(mode,a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 if(equ(ae,e))SPB(zp,e,sc(j))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 else{RE(k=i0(indexofsub(mode,ax,e))); SPB(zp,e,sc(AN(ay)?(m>k?yv[k]:n):k));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 RZ(q=indexofsub(mode,ax,x)); v=AV(q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 if(AN(ay)||AN(SPA(ap,a))){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 DO(AN(x), k=*v; *v++=m>k?yv[k]:n;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 if(j<n){RZ(p=eq(ae,x)); pv=BAV(p); v=AV(q); DO(AN(x), if(pv[i])*v=j; ++v;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 SPB(zp,x,q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 }else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 if(h&&t!=at)RZ(a=cvt(t,a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 SPB(zp,e,indexofsub(mode,a,e));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 SPB(zp,x,indexofsub(mode,a,x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 } /* vector i. sparse */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 A jtiovsd(J jt,I mode,A a,A w){A ae,ax,ay,p,z;B h,*pv;I at,j,m,n,t,wt,*v,*yv;P*ap;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 ap=PAV(a); ax=SPA(ap,x); ay=SPA(ap,i);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 if(!AN(ay))R indexofsub(mode,ravel(ax),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 m=AN(ax); n=*AS(a); yv=AV(ay); ae=SPA(ap,e);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 at=DTYPE(AT(a)); wt=AT(w); if(h=HOMO(at,wt))t=maxtype(at,wt);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 if(h&&t!=wt)RZ(w=cvt(t,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 j=ioev(mode,a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 RZ(z=indexofsub(mode,ax,w)); v=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 RZ(p=eq(ae,w)); pv=BAV(p);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 DO(AN(w), *v=pv[i]?j:m>*v?yv[*v]:n; ++v;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 } /* (sparse vector) i. dense */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 A jtindexofxx(J jt,I mode,A a,A w){A x;B*b,*c,s;I ar,d,j,m,n,wr;P*p;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69 s=1&&SPARSE&AT(a); ar=AR(a); wr=AR(w); d=wr-ar;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 if(s){p=PAV(a); m=ar; n=wr;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 else {p=PAV(w); m=wr; n=ar;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 RZ(b=bfi(m,SPA(p,a),1)); b[0]=1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 GA(x,B01,n,1,0); c=BAV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 if(s)DO(d, c[i]=1;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 j=0; DO(MIN(ar,wr), ++j; c[n-j]=b[m-j];);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 R indexofss(mode,s?a:reaxis(ifb(n,c),a),s?reaxis(ifb(n,c),w):w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 } /* dense i. sparse or sparse i. dense; 1<AR(a) */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 static F1(jtifdz){I m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 m=bp(AT(w))/sizeof(I); AN(w)*=m; *(1+AS(w))*=m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 AT(w)=INT;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 R w;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 } /* INT from FL or CMPX, in place */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 static A jtioe(J jt,I mode,A w){A b,j,p,y;I c,jn,*jv,k,n;P*wp;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 wp=PAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 n=*AS(w); y=SPA(wp,i);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 if(!AN(y))R sc(1==mode?(n?n-1:0):0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 RZ(b=eq(SPA(wp,e),SPA(wp,x)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 if(2<AR(b)){*(1+AS(b))=aii(b); AR(b)=2;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 if(1<AR(b))RZ(b=aslash1(CSTARDOT,b)); /* b=. *./@,"_1 (3$.w)=5$.w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 RZ(y=irs2(zero,y,0L,0L,1L,jtfrom));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 RZ(p=df2(y,b,sldot(slash(ds(CSTARDOT)))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 RZ(j=repeat(not(p),repeat(ne(y,curtail(over(num[-1],y))),y)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 jn=AN(j); jv=AV(j);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97 if(n==jn)k=n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 if(1==mode){k=*jv-1; jv+=jn-1; c=n; DO(jn, --c; if(c!=*jv--){k=c; break;});} /* i: */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 else {k=1+jv[jn-1]; DO(jn, if(i!=*jv++){k=i; break;});} /* i. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 R sc(k);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 } /* index of sparse item; leading axis is sparse */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 static B jtioresparse(J jt,B aw,A*za,A*zw){A a,e,w;B*ab,ac=0,*wb,wc=0;I ar,j,wr;P*ap,*wp;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 a=*za; ar=AR(a); ap=PAV(a); RZ(ab=bfi(ar,SPA(ap,a),1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 if(!*ab)*ab=ac=1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 if(aw){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 w=*zw; wr=AR(w); wp=PAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 e=SPA(ap,e); if(!equ(e,SPA(wp,e))){RZ(w=rezero(e,w)); wp=PAV(w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 RZ(wb=bfi(wr,SPA(wp,a),1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 j=wr-ar; DO(ar-1, ++j; if(ab[1+i]<wb[j])ab[1+i]=ac=1; else if(ab[1+i]>wb[j])wb[j]=wc=1;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 DO(1+wr-ar, if(!wb[i])wb[i]=wc=1;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 if( ac)RZ(*za=reaxis(ifb(ar,ab),a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 if(aw&&wc)RZ(*zw=reaxis(ifb(wr,wb),w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 R 1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 } /* harmonize sparse elements and sparse axes for a and w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 static B jtiopart(J jt,A w,I r,I mm,I*zc,A*zi,A*zj,A*zx){A b,f,wx,x,wy,y;B*bv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 I c=*zc,d,i,j,k,m,n,nd,p,q,wr,*v,*xv;P*wp;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 wr=AR(w); d=wr-r;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 wp=PAV(w); wy=SPA(wp,i); wx=SPA(wp,x); n=AR(wx)-1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 RZ(b=not(irs2(wx,reshape(vec(INT,n,1+AS(wx)),SPA(wp,e)),0L,n,n,jtmatch)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 if(!all1(b)){RZ(wx=repeat(b,wx)); RZ(wy=repeat(b,wy));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 v=AV(wy); m=*AS(wy); n=*(1+AS(wy)); nd=n-d;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 GA(b,B01,m,1,0); bv=BAV(b);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 if (0==d){memset(bv,C0,m); if(m)*bv=1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 else if(1==d){j=-1; DO(m, bv[i]=j!=*v; j=*v; v+=n;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 GA(x,INT,d,1,0); xv=AV(x); *xv=-1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 DO(m, bv[i]=0; DO(d, if(xv[i]!=v[i]){bv[i]=1; j=i; DO(d-j, xv[j]=v[j]; ++j;); break;}); v+=n;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 if(m){RZ(f=cut(ds(CCOMMA),one)); RZ(y=df2(b,dropr(d,wy),f)); RZ(x=df2(b,wx,f));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135 else{y=mtm; RZ(x=reshape(v2(0L,prod(r,AS(w)+wr-r)),wx));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136 if(0>c)*zc=c=*(1+AS(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137 else if(c!=*(1+AS(y))){RZ(y=taker(c,y)); RZ(x=taker((c/(n-d))*aii(wx),x));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 v=AV(y); k=0; q=*AS(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139 for(i=0;i<q;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140 j=k; k=1+j; while(k<m&&!bv[k])++k; p=nd*(k-j);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141 if(c<p)*v=mm; else DO(c-p, v[p+i]=mm;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
142 v+=c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
143 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
144 RZ(*zi=repeat(b,taker(d,wy)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
145 *zj=y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
146 *zx=x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
147 R 1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
148 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
149
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
150 A jtindexofss(J jt,I mode,A a,A w){A ai,aj,ax,wi,wj,wx,x,y,z;B aw=a!=w;I ar,c,m,mm,n,r,*u,*v,wr;P*ap,*wp,*zp;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
151 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
152 ar=AR(a); ap=PAV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
153 wr=AR(w); wp=PAV(w); r=1+wr-ar;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
154 RZ(ioresparse(aw,&a,&w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
155 v=AS(a); n=*v++; mm=-1; DO(ar-1, mm=MAX(mm,v[i]););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
156 c=-1; RZ(iopart(a,ar-1,mm,&c,&ai,&aj,&ax));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
157 if(aw)RZ(iopart(w,ar-1,mm,&c,&wi,&wj,&wx));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
158 switch(aw?(FL+CMPX&maxtype(AT(ax),AT(wx))?3:1):FL+CMPX&AT(ax)?2:0){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
159 case 0: x=stitch(aj,ax); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
160 case 1: x=stitch(aj,ax); y=stitch(wj,wx); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
161 case 2: x=stitch(aj,jt->ct?iocol(mode,ax,ax):ifdz(ax)); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
162 case 3: x=stitch(aj,jt->ct?iocol(mode,ax,ax):ifdz(ax));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
163 y=stitch(wj,jt->ct?iocol(mode,ax,wx):ifdz(wx));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
164 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
165 RZ(x=indexofsub(mode,x,aw?y:x)); u=AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
166 m=*AS(ai); v=AV(ai);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
167 if(aw)DO(AN(x), u[i]=m>u[i]?v[u[i]]:n;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
168 else DO(AN(x), u[i]=v[u[i]];);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
169 if(!r)R AN(x)?sc(*u):ioe(mode,a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
170 GA(z,SINT,1,r,AS(w)); zp=PAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
171 SPB(zp,a,IX(r));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
172 SPB(zp,e,ioe(mode,a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
173 SPB(zp,i,aw?wi:ai);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
174 SPB(zp,x,x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
175 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
176 } /* sparse i. sparse */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
177
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
178 F1(jtnubsievesp){A e,x,y,z;I c,j,m,n,r,*s,*u,*v,*vv,wr,*yv;P*p;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
179 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
180 wr=AR(w); r=jt->rank?jt->rank[1]:wr; jt->rank=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
181 n=r?*(AS(w)+wr-r):1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
182 if(r<wr)R irs2(IX(n),irs2(w,w,0L,r,r,jtindexof),0L,1L,r?1L:0L,jteq);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
183 RZ(x=indexof(w,w)); p=PAV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
184 y=SPA(p,i); u=AV(y); c=*AS(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
185 x=SPA(p,x); v=AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
186 e=SPA(p,e); j=*AV(e); m=j<n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
187 DO(c, m+=u[i]==v[i];);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
188 GA(y,INT,m,2,0); s=AS(y); s[0]=m; s[1]=1; vv=yv=AV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
189 if(c)DO(c, if(u[i]==v[i]){if(j<u[i]){*vv++=j; j=n;} *vv++=u[i];})
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
190 if(m&&vv<yv+m)*vv=j;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
191 GA(z,SB01,1,1,&n); p=PAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
192 SPB(p,a,iv0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
193 SPB(p,e,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
194 SPB(p,i,y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
195 SPB(p,x,reshape(sc(m),one));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
196 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
197 }