Mercurial > hg > jgplsrc

annotate vp.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: Permutations */
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 jtord(J jt,A w){I j,n,*v,z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11 n=AN(w); z=-n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 if(n){if(!(INT&AT(w)))RZ(w=cvt(INT,w)); v=AV(w); DO(n, j=*v++; if(z<j)z=j;); ++z;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16 F1(jtpinv){I m=0,n,*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 F1RANK(1,jtpinv,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18 RZ(w=vi(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 n=AN(w); v=AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 DO(n, m=0>v[i]?MAX(m,-1-v[i]):MAX(m,v[i]);); m+=0<n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21 R indexof(pfill(m,w),IX(m));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 } /* permutation inverse */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 A jtpind(J jt,I n,A w){A z;I j,m,*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 RE(n); RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 m=-n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 RZ(z=ca(vi(w))); v=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 DO(AN(z), j=*v; ASSERT(m<=j&&j<n,EVINDEX); *v++=0>j?j+n:j;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 } /* positive indices */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 A jtpfill(J jt,I n,A w){PROLOG;A b,z;B*bv,*v;I*wv,*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 RZ(w=pind(n,w)); wv=AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34 GA(z,INT,n,1,0); zv=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 GA(b,B01,n,1,0); bv=BAV(b); memset(bv,C1,n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 DO(AN(w), v=bv+wv[i]; ASSERT(*v,EVINDEX); *v=0;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 DO(n, if(bv[i])*zv++=i;); ICPY(zv,wv,AN(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 EPILOG(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 static F1(jtcfd){A b,q,x,z,*zv;B*bv;I c,i,j,n,*qv,*u,*v,zn;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 if(c=1&&INT&AT(w)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 n=AN(w); v=AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 GA(b,B01,1+n,1,0); bv=BAV(b); memset(bv,C0,n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 DO(n, j=v[i]; if(j<0||n<=j||bv[j]){c=0; break;} bv[j]=1;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 if(!c){n=ord(w); RZ(w=pfill(n,w)); v=AV(w); GA(b,B01,1+n,1,0);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 bv=BAV(b); memset(bv,C0,1+n); ++bv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 i=0; j=n-1; zn=(I)(log((D)n)+1.6);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 GA(q,INT,n, 1,0); qv= AV(q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52 GA(z,BOX,zn,1,0); zv=AAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 while(1){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 while(bv[j])--j; if(0>j)break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 u=qv; c=j;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 do{bv[c]=1; *u++=c; c=v[c];}while(c!=j);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 if(i==zn){RZ(z=ext(0,z)); zv=AAV(z); zn=AN(z);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 RZ(zv[i++]=vec(INT,u-qv,qv));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 AN(z)=*AS(z)=zn=i; j=zn-1; DO(zn/2, x=zv[i]; zv[i]=zv[j]; zv[j]=x; --j;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 } /* cycle from direct */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 static A jtdfc(J jt,I n,A w){PROLOG;A b,q,*wv,z;B*bv;I c,j,qn,*qv,*x,wd;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 RE(n); RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 ASSERT(0<=n,EVINDEX);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 GA(b,B01,n,1,0); bv=BAV(b); memset(bv,C1,n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 RZ(z=IX(n)); x=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69 wv=AAV(w); wd=(I)w*ARELATIVE(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 for(j=AN(w)-1;0<=j;j--){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 RZ(q=pind(n,WVR(j))); qv=AV(q); qn=AN(q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 if(!qn)continue;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 DO(qn, ASSERT(bv[qv[i]],EVINDEX); bv[qv[i]]=0;); DO(qn,bv[qv[i]]=1;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 c=x[qv[0]]; DO(qn-1,x[qv[i]]=x[qv[i+1]];); x[qv[qn-1]]=c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 EPILOG(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 } /* direct from cycle */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 F1(jtcdot1){F1RANK(1,jtcdot1,0); R BOX&AT(w)?dfc(ord(raze(w)),w):cfd(w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 F2(jtcdot2){A p;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 F2RANK(1,RMAX,jtcdot2,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 RZ(p=BOX&AT(a)?dfc(IC(w),a):pfill(IC(w),a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 R AR(w)?from(p,w):w;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 F1(jtpparity){A x,y,z;B p,*u;I i,j,k,m,n,r,*s,*v,*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 RZ(x=cvt(INT,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 r=AR(x); s=AS(x); n=r?*(s+r-1):1; RE(m=prod(r-1,s)); v=AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 GA(y,B01,n,1,0); u=BAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 GA(z,INT,m,r?r-1:0,s); zv=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 for(i=0;i<m;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 j=p=0; memset(u,C1,n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 DO(n, k=v[i]; if(0>k)v[i]=k+=n; if(0<=k&&k<n&&u[k])u[k]=0; else{j=1+n; break;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 for(;j<n;++j)if(j!=v[j]){k=j; DO(n-j-1, ++k; if(j==v[k]){v[k]=v[j]; p=!p; break;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 zv[i]=p?-1:j==n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97 v+=n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 } /* permutation parity; # interchanges to get i.n */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 static F1(jtdfr){A z;I c,d,i,j,m,n,*v,*x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 n=*(AS(w)+AR(w)-1); m=n?AN(w)/n:0; v=AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 GA(z,INT,AN(w),AR(w),AS(w)); x=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 for(i=0;i<m;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 DO(n, x[i]=i;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 DO(n-1, j=i; c=x[j+v[j]]; DO(1+v[j], d=x[j+i]; x[j+i]=c; c=d;););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 x+=n; v+=n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 } /* direct from reduced */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 static F1(jtrfd){A z;I j,k,n,r,*s,*x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 RZ(z=ca(w)); x=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 r=AR(w); s=AS(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 if(n=s[r-1])DO(AN(w)/n, j=n-1; ++x; DO(n-1, k=0; DO(j--, k+=*x>x[i];); *x++=k;););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 } /* reduced from direct */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 F1(jtadot1){A y;I n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 F1RANK(1,jtadot1,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 RZ(y=BOX&AT(w)?cdot1(w):pfill(ord(w),w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 n=IC(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 R base2(cvt(XNUM,apv(n,n,-1L)),rfd(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 F2(jtadot2){A m,p;I n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 n=IC(w); p=sc(n); if(XNUM&AT(a))p=cvt(XNUM,p); RZ(m=fact(p));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 ASSERT(all1(le(negate(m),a))&&all1(lt(a,m)),EVINDEX);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 if(!AR(w)){RZ(vi(a)); R ca(w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 RZ(p=dfr(vi(abase2(apv(n,n,-1L),a))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 R equ(w,IX(n))?p:from(p,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136