Mercurial > hg > jgplsrc
view cd.c @ 0:e0bbaa717f41 draft default tip
lol J
author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
---|---|
date | Mon, 25 Nov 2013 11:56:30 -0500 |
parents | |
children |
line wrap: on
line source
/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */ /* License in license.txt. */ /* */ /* Conjunctions: Differentiation and Integration */ #include "j.h" static B jtiscons(J jt,A w){A x;V*v; RZ(w); v=VAV(w); x=v->f; R CQQ==v->id&&NOUN&AT(x)&&!AR(x); } static C ispoly1[]={CLEFT,CRIGHT,CLE,CGE,CNOT,CMINUS,CPLUSCO,CHALVE,CCIRCLE,CJDOT,0}; static I jtispoly(J jt,A w){A e,f,g,h,x,y;B nf,ng,vf,vg;C c,id;I k,m,n,t;V*v; RZ(w); v=VAV(w); id=v->id; if(id==CFCONS||iscons(w))R 1; if(strchr(ispoly1,id))R 2; if(id==CSTARCO)R 3; f=v->f; nf=f&&NOUN&AT(f); vf=!nf; g=v->g; ng=g&&NOUN&AT(g); vg=!ng; x=nf?f:g; t=x?AT(x):0; h=nf?g:f; c=h?ID(h):0; if(id==CFORK){ RZ(vf&&vg); m=ispoly(f); n=ispoly(v->h); switch(m&&n?ID(g):0){ case CPLUS: R MAX(m,n); case CSTAR: R m+n-1; }} if(vf&&vg&&(id==CAT||id==CATCO||id==CAMP||id==CAMPCO)){m=ispoly(f); n=ispoly(g); if(m&&n)R 1+(m-1)*(n-1);} RZ(id==CAMP&&(t&NUMERIC||c==CPOLY)); if(nf&&1>=AR(x)&&c==CPOLY){ RZ(t&BOX+NUMERIC); k=IC(x); if(t&NUMERIC)R k; y=*(AAV(x)+k-1); RZ(2>=AR(y)); if(1>=AR(y))R 1+IC(y); RZ(2==*(1+AS(y))); RZ(e=irs1(y,0L,1L,jttail)); RZ(equ(e,floor1(e))&&all1(le(zero,e))); RZ(y=aslash(CMAX,cvt(INT,e))); R 1+*AV(y); } if(nf==ng||AR(x))R 0; if(c==CPLUS||c==CMINUS||c==CSTAR||c==CDIV&&ng)R 2; RZ(x=pcvt(INT,x)); if(!(INT&AT(x)))R 0; k=*AV(x); R 0<=k&&(c==CBANG&&nf||c==CEXP&&ng)?1+k:0; } /* 1 + degree of polynomial (0 if not poly) */ static F1(jtfpolyc){A b;B*bv;I m,n; RZ(b=ne(w,zero)); bv=BAV(b); m=n=AN(w); DO(n, if(bv[--m])break;); ++m; if(m<n)RZ(w=take(sc(m),w)); n=m; switch(n){ case 1: R qq(head(w),zero); case 3: if(equ(w,over(v2(0L,0L),one)))R ds(CSTARCO); break; case 2: if(equ(w,v2( 0L,-1L))) R ds(CMINUS); if(equ(w,v2( 1L,-1L))) R ds(CNOT); if(equ(w,v2(-1L, 1L))) R ds(CLE); if(equ(w,v2( 0L, 1L))) R ds(CLEFT); if(equ(w,v2( 1L, 1L))) R ds(CGE); if(equ(w,v2( 0L, 2L))) R ds(CPLUSCO); if(equ(w,over(zero,scf((D)0.5))))R ds(CHALVE); if(equ(w,over(zero,scf(PI ))))R ds(CCIRCLE); if(equ(w,over(zero,a0j1 )))R ds(CJDOT); } R amp(w,ds(CPOLY)); } static A jtfpoly(J jt,I n,A f){I m=0>n?1:1+n; RZ(f); R fpolyc(df1(IX(m),tdot(f)));} static F1(jtfnegate){V*v; RZ(w); v=VAV(w); R CAT==v->id&&CMINUS==ID(v->f)?v->g:atop(ds(CMINUS),w);} static F2(jtfplus){ RZ(a&&w); if(iscons(a)&&equ(VAV(a)->f,zero))R w; if(iscons(w)&&equ(VAV(w)->f,zero))R a; R folk(a,ds(CPLUS),w); } static F2(jtfminus){ RZ(a&&w); if(iscons(a)&&equ(VAV(a)->f,zero))R fnegate(w); if(iscons(w)&&equ(VAV(w)->f,zero))R a; R folk(a,ds(CMINUS),w); } static F2(jtftymes){A x,y;B b,c;I k; RZ(a&&w); b=iscons(a); x=VAV(a)->f; c=iscons(w); y=VAV(w)->f; if(CFORK==ID(w)&&NOUN&AT(y))R ftymes(a,folk(qq(y,ainf),VAV(w)->g,VAV(w)->h)); if(b&&AT(x)&B01+INT){k=i0(x); if(-1<=k&&k<=1)R !k?a:0<k?w:fnegate(w);} if(c&&AT(y)&B01+INT){k=i0(y); if(-1<=k&&k<=1)R !k?w:0<k?a:fnegate(a);} if(b&&CFORK==ID(w)&&iscons(y))R ftymes(qq(tymes(x,VAV(y)->f),zero),VAV(w)->h); R c?folk(w,ds(CSTAR),a):folk(a,ds(CSTAR),w); } static F1(jtdpoly){A c,e,x;I n,t; RZ(w); n=AN(w); t=AT(w); ASSERT(!n||t&NUMERIC+BOX,EVDOMAIN); if(!n||t&NUMERIC)R 2>=n?qq(2==n?tail(w):cvt(n?t:B01,zero),zero):fpolyc(behead(tymes(w,IX(n)))); x=AAV0(w); if(1<n||1>=AR(x))R dpoly(poly1(w)); ASSERT(2==AR(x)&&2==*(1+AS(x)),EVDOMAIN); c=irs1(x,0L,1L,jthead); e=irs1(x,0L,1L,jttail); R amp(box(stitch(tymes(c,e),minus(e,one))),ds(CPOLY)); } static F1(jtipoly){A b,c,e,p=0,q=0,x;I n,t; RZ(w); n=AN(w); t=AT(w); ASSERT(!n||t&NUMERIC+BOX,EVDOMAIN); if(!n||t&NUMERIC)R fpolyc(over(zero,divide(w,apv(n,1L,1L)))); x=AAV0(w); if(1<n||1>=AR(x))R ipoly(poly1(w)); ASSERT(2==AR(x)&&2==*(1+AS(x)),EVDOMAIN); RZ(c=irs1(x,0L,1L,jthead)); RZ(e=plus(one,irs1(x,0L,1L,jttail))); RZ(b=ne(e,zero)); if(!all0(b))RZ(p=amp(box(repeat(b,stitch(divide(c,e),e))),ds(CPOLY))); if(!all1(b))RZ(q=evc(not(b),c,"(+/x#y)&*@^.")); R p&&q?folk(p,ds(CPLUS),q):p?p:q; } static F1(jticube){R atco(eval("* =/~@(i.@$)"),w);} static F1(jtdiffamp0){A f,g,h,x,y;B nf,ng;C id;V*v; RZ(w); v=VAV(w); f=v->f; nf=1&&NOUN&AT(f); g=v->g; ng=1&&NOUN&AT(g); h=nf?g:f; id=ID(h); x=nf?f:g; RZ(!AR(x)||id==CPOLY); switch(id){ case CPLUS: R qq(one,zero); case CSTAR: R qq(x,zero); case CMINUS: R qq(num[nf?-1:1],zero); case CDIV: R nf?eva(x,"(-x)&%@*:"):qq(recip(x),zero); case CPOLY: if(nf)R dpoly(x); break; case CBANG: if(nf&&!AR(x))R dpoly(df1(iota(increm(x)),tdot(w))); break; case CROOT: if(nf&&!AR(x))R atop(amp(recip(x),ds(CSTAR)),amp(ds(CEXP),decrem(recip(x)))); break; case CLOG: R eva(logar1(x),nf?"(%x)&%":"(-x)&%@(* *:@^.)"); case CEXP: if(nf)R evc(x,w,"(^.x)&*@y"); RZ(y=pcvt(INT,x)); if(INT&AT(y))switch(*AV(y)){ case 0: R qq(zero,zero); case 1: R qq(one,zero); case 2: R ds(CPLUSCO); } R eva(x,"x&*@(^&(x-1))"); case CCIRCLE: if(nf){ RZ(x=vi(x)); switch(*AV(x)){ case 0: R folk(ds(CMINUS),ds(CDIV),w); case 1: R amp(num[2],h); case 2: R atop(ds(CMINUS),amp(one,h)); case 3: R atop(atop(ds(CDIV),ds(CSTARCO)),amp(num[2],h)); case 5: R amp(num[6],h); case 6: R amp(num[5],h); case 7: R atop(atop(ds(CDIV),ds(CSTARCO)),amp(num[6],h)); }}} R 0; } static F1(jtdiff0){A df,dg,dh,f,g,h,x,y,z;B b,nf,ng,vf,vg;C id;I m,p,q;V*v; RZ(w); v=VAV(w); id=v->id; f=v->f; nf=f&&NOUN&AT(f); vf=f&&!nf; g=v->g; ng=g&&NOUN&AT(g); vg=g&&!ng; if(id==CAMP&&nf!=ng)R diffamp0(w); switch(id){ case CLE: case CGE: case CLEFT: case CRIGHT: R qq(one,zero); case CPLUSCO: R qq(num[2],zero); case CNOT: case CMINUS: R qq(num[-1],zero); case CFCONS: R qq(zero,zero); case CSTARCO: R ds(CPLUSCO); case CHALVE: R qq(connum(3L,"1r2"),zero); case CCIRCLE: R qq(pie,zero); case CDIV: R eval("- @%@*:"); case CSQRT: R eval("-:@%@%:"); case CEXP: R w; case CLOG: R ds(CDIV); case CJDOT: R qq(a0j1,zero); case CRDOT: R atop(ds(CJDOT),w); case CDDOT: if(vf&&ng)R ddot(f,increm(g)); break; case CPOWOP: if(vf&&ng&&!AR(g))switch(p=i0(g)){ case -1: R diff0(inv(f)); case 0: RE(0); R qq(one,zero); case 1: R diff0(f); default: if(0>p){RZ(f=inv(f)); p=-p;} if(q=ispoly(f)){RE(m=i0(vib(expn2(sc(q-1),g)))); R dpoly(df1(IX(1+m),tdot(w)));} R diff0(atop(powop(f,sc(p-1)),f)); } break; case CQQ: if(!AR(f)&&NUMERIC&AT(f)&&ng&&equ(g,zero))R qq(zero,zero); if(vf&&ng)R qq(diff0(f),g); break; case CAT: case CATCO: case CAMP: case CAMPCO: if(vf&&vg){ p=ispoly(f); q=ispoly(g); if(p&&q)R dpoly(df1(IX(1+(p-1)*(q-1)),tdot(w))); RZ(dg=diff0(g)); RZ(df=diff0(f)); v=VAV(df); x=v->f; if(CQQ!=v->id)R ftymes(dg,atop(df,g)); switch(CQQ==v->id&&AT(x)&B01+INT?i0(x):9){ case 0: R df; case 1: R dg; case 2: R atop(ds(CPLUSCO),dg); case -1: R fnegate(dg); default: R ftymes(df,dg); }} break; case CTILDE: if(vf)switch(ID(f)){ case CPLUS: R qq(num[2],zero); case CSTAR: R ds(CPLUSCO); case CMINUS: case CLOG: case CDIV: R qq(zero,zero); case CEXP: R eva(w,"x * >:@^."); } break; case CFORK: h=v->h; if(NOUN&AT(f))R diff0(folk(qq(f,zero),g,h)); if(CCAP==ID(f))R diff0(atco(g,h)); p=ispoly(f); df=diff0(f); q=ispoly(h); dh=diff0(h); b=p&&q; switch(ID(g)){ case CPLUS: z=fplus (df,dh); R b?fpoly(MAX(p,q)-1,z):z; case CMINUS: z=fminus(df,dh); R b?fpoly(MAX(p,q)-1,z):z; case CSTAR: z=fplus(ftymes(df,h),ftymes(f,dh)); R b?fpoly(p+q,z):z; case CCOMMA: R folk(df,g,dh); case CDIV: x=fminus(ftymes(df,h),ftymes(f,dh)); y=atop(ds(CSTARCO),h); R folk(b?fpoly(p+q-1-(p==q),x):x,ds(CDIV),q?fpoly(q+q,y):y); case CEXP: if(1==q){A k; RZ(k=df1(zero,h)); if(equ(k,zero))R qq(zero,zero); if(equ(k,one))R df; if(equ(k,num[2]))R ftymes(df,ftymes(h,f)); R ftymes(df,ftymes(h,folk(f,g,qq(decrem(k),zero)))); } }} R 0; } static F1(jtintgamp0){A f,g,h,x,y;B nf,ng;C id;V*v; RZ(w); v=VAV(w); f=v->f; nf=1&&NOUN&AT(f); g=v->g; ng=1&&NOUN&AT(g); h=nf?g:f; id=ID(h); x=nf?f:g; RZ(!AR(x)||id==CPOLY); switch(id){ case CPLUS: R ipoly(over(x,one)); case CSTAR: R ipoly(over(zero,x)); case CMINUS: R nf?ipoly(over(x,num[-1])):ipoly(over(negate(x),one)); case CDIV: R nf?eva(x,"x&*@^."):ipoly(over(zero,recip(x))); case CPOLY: if(nf)R ipoly(x); break; case CBANG: if(nf&&AT(x))R ipoly(df1(iota(increm(x)),tdot(w))); break; case CEXP: if(ng&&!AR(x)){ if(equ(x,num[-1]))R ds(CLOG); RZ(y=pcvt(INT,x)); R INT&AT(y)?ipoly(take(sc(-1-i0(y)),one)):atop(amp(ds(CDIV),increm(y)),amp(ds(CEXP),increm(y))); } case CCIRCLE: if(nf){ RZ(x=vi(x)); switch(*AV(x)){ case 1: R atop(ds(CMINUS),amp(num[2],h)); case 2: R amp(one,h); case 3: R eval("-@^.@(2&o.)"); case 5: R amp(num[6],h); case 6: R amp(num[5],h); case 7: R atop(ds(CLOG),amp(num[6],h)); }}} R 0; } static F1(jtintg0); static F2(jtintgatop){A df,f=a,g=w,q,x,y;I m,n;V*v; RZ(a&&w); m=ispoly(f); n=ispoly(g); if(m&&n)R ipoly(df1(IX(1+(m-1)*(n-1)),tdot(atop(a,w)))); if(2==m){ RZ(q=v2(0L,1L)); RZ(x=df1(q,tdot(f))); RZ(y=equ(one, tail(x))?intg0(g):atop(fpolyc(tymes(q,x)),intg0(g))); R equ(zero,head(x))?y :folk(y,ds(CPLUS),amp(head(x),ds(CSTAR))); } if(1==n||2==n){ df=atop(intg0(f),g); if(1==n)R df; RZ(x=df1(one,tdot(g))); R equ(x,one)?df:atop(amp(ds(CDIV),x),df); } v=VAV(g); if(m&&equ(take(sc(-m),one),df1(IX(m),tdot(f)))){ /* ^&m @ g */ if(CLOG==v->id)R 1==m?ds(CRIGHT):2==m?intg0(g):eva(sc(m-1),"(] * ^&x@^.) - x&* @(^&(x-1)@^. d. _1)"); if(CAMP==v->id&&CCIRCLE==ID(v->g)&&(y=v->f,!AR(y)&&equ(y,floor1(y)))){ if(2>=m)R 1==m?ds(CRIGHT):intgamp0(g); switch(i0(y)){ case 1: R eva(sc(m-1),"%&(-x )@(^&(x-1)@(1&o.) * 2&o.) + ((x-1)%x)&*@(^&(x-2)@(1&o.) d. _1)"); case 2: R eva(sc(m-1),"%&x @(^&(x-1)@(2&o.) * 1&o.) + ((x-1)%x)&*@(^&(x-2)@(2&o.) d. _1)"); case 3: R eva(sc(m-1),"%&(x-1)@(^&(x-1)@(3&o.) ) - ^&(x-2)@(3&o.) d. _1 "); case 7: R eva(sc(m-1),"%&(1-x)@(^&(x-1)@(7&o.) ) + ^&(x-2)@(7&o.) d. _1 "); }}} R 0; } /* integral of a @ w */ static F2(jtintgtymes){A f=a,g=w; RZ(a&&w); R 0; } /* integral of a * w */ static F1(jtintg0){A df,dh,f,g,h;B nf,ng,vf,vg;C id;I m,n,p,q;V*fv,*gv,*v; RZ(w); id=ID(w); v=VAV(w); f=v->f; nf=f&&NOUN&AT(f); if(vf=f&&!nf)fv=VAV(f); g=v->g; ng=g&&NOUN&AT(g); if(vg=g&&!ng)gv=VAV(g); if(id==CAMP&&nf!=ng)R intgamp0(w); switch(id){ case CLE: R ipoly(v2(-1L, 1L)); case CGE: R ipoly(v2( 1L, 1L)); case CLEFT: case CRIGHT: R ipoly(v2( 0L, 1L)); case CNOT: R ipoly(v2( 1L,-1L)); case CMINUS: R ipoly(v2( 0L,-1L)); case CPLUSCO: R ds(CSTARCO); case CFCONS: R amp(v->h,ds(CSTAR)); case CSTARCO: R ipoly(over(v2(0L,0L),one)); case CHALVE: R ipoly(over(zero,scf((D)0.5))); case CCIRCLE: R ipoly(over(zero,scf(PI ))); case CDIV: R ds(CLOG); case CSQRT: R eval("%: * (0 2%3)&p."); case CEXP: R w; case CLOG: R eval("(]*^.) - ]"); case CJDOT: R ipoly(over(zero,a0j1)); case CRDOT: R eval("-@j.@r."); case CDDOT: if(vf&&ng)R ddot(f,decrem(g)); break; case CPOWOP: if(vf&&ng&&!AR(g))switch(p=i0(g)){ case -1: R intg0(inv(f)); case 0: RE(0); R ipoly(v2(0L,1L)); case 1: R intg0(f); default: if(0>p){RZ(f=inv(f)); p=-p;} if(q=ispoly(f)){RE(m=i0(vib(expn2(sc(q-1),g)))); R ipoly(df1(IX(1+m),tdot(w)));} R intg0(atop(powop(f,sc(p-1)),f)); } break; case CQQ: if(!AR(f)&&NUMERIC&AT(f)&&ng&&equ(g,zero))R amp(f,ds(CSTAR)); if(vf&&ng)R qq(intg0(f),g); break; case CAT: case CATCO: case CAMP: case CAMPCO: if(vf&&vg)R intgatop(f,g); break; case CTILDE: if(vf)switch(ID(f)){ case CPLUS: R ipoly(v2(0L,2L)); case CSTAR: R ipoly(over(v2(0L,0L),one)); case CMINUS: R FCONS(zero); case CLOG: case CDIV: R ds(CRIGHT); } break; case CFORK: h=v->h; if(NOUN&AT(f))R intg0(folk(qq(f,zero),g,h)); dh=intg0(h); n=ispoly(h); df=intg0(f); m=ispoly(f); switch(ID(g)){ case CPLUS: R m&&n ? (p=MAX(m,n),ipoly(df1(IX(p),tdot(w)))) : fplus(df,dh); case CMINUS: R m&&n ? (p=MAX(m,n),ipoly(df1(IX(p),tdot(w)))) : fminus(df,dh); case CSTAR: if(m&&n){p=2+(m-1)*(n-1); R ipoly(df1(IX(p),tdot(w)));} R intgtymes(f,h); }} R 0; } static DF1(jtddot1){V*v=VAV(self); R df1(w,ddot(fix(v->f),v->g));} F2(jtddot){A x,*xv,y,z;AF f;I j,n,p,q,r,*wv; RZ(a&&w); ASSERT(NOUN&AT(w),EVDOMAIN); RZ(w=vi(w)); r=AR(w); n=AN(w); wv=AV(w); if(NOUN&AT(a)){ASSERT(0,EVNONCE);} if(!nameless(a)||1<r)R CDERIV(CDDOT, jtddot1,0L, 0L,0L,0L); irange(n,wv,&p,&q); if(!r){ if(!p){V*v=VAV(a); R v->mr||v->lr||v->rr?qq(a,zero):a;} f=0<=p?jtdiff0:jtintg0; y=a; DO(ABS(p), ASSERT(y=CALL1(f,y,0L),EVDOMAIN);); R y; } q+=p-1; p=0>p?p:0; q=0<q?q:0; GA(x,BOX,1+q-p,1,0); xv=AAV(x); xv[-p]=a; if(0>p){y=a; j=-p; DO(-p, ASSERT(y=intg0(y),EVDOMAIN); xv[--j]=y;);} if(0<q){y=a; j=-p; DO( q, ASSERT(y=diff0(y),EVDOMAIN); xv[++j]=y;);} j=n; z=xv[wv[--j]-p]; DO(n-1, RZ(z=folk(xv[wv[--j]-p],ds(CCOMMA),z));); R qq(z,zero); } static F1(jtdiffamp){A f,g,h,x,y;B nf,ng;V*v; RZ(w); v=VAV(w); f=v->f; nf=1&&NOUN&AT(f); g=v->g; ng=1&&NOUN&AT(g); h=nf?g:f; x=nf?f:g; switch(ID(h)){ case CROT: case CCANT: case CLBRACE: case CATOMIC: case CCYCLE: if(nf)R atop(hook(eval("=/"),w),eval("i.@$")); break; case CPOLY: if(nf&&1>=AR(x))R dpoly(NUMERIC&AT(x)?x:poly1(x)); break; case CBANG: if(!AR(x)&&(x=pcvt(INT,x),INT&AT(x)))R dpoly(df1(IX(1+*AV(x)),tdot(w))); break; case CFIT: if(nf&&1>=AR(x)&&(y=VAV(h)->f,CPOLY==ID(y)))R dpoly(df1(IX(IC(x)),tdot(w))); } R 0; } static F1(jtdiff){A df,dh,f,g,h,z;B nf,ng,vf,vg;C id;I r;V*v; RZ(w); ASSERT(VERB&AT(w),EVDOMAIN); v=VAV(w); id=v->id; r=v->mr; f=v->f; nf=f&&NOUN&AT(f); vf=f&&!nf; g=v->g; ng=g&&NOUN&AT(g); vg=g&&!ng; if(nf&&id==CFORK)R diff(folk(qq(f,ainf),g,v->h)); if(z=diff0(w))R id==CQQ&&ng&&equ(g,zero)?z:icube(z); if(id==CAMP&&nf!=ng)R diffamp(w); switch(id){ case CREV: R eval("(|.=/])@(i.@$)"); case CCANT: R eval("(|:=/])@(i.@$)"); case CHGEOM: R hgdiff(w); case CSLASH: switch(ID(f)){ case CPLUS: R eval("({. =/ */@}.@$ | ])@(i.@$)"); } break; /* ----- commented out because it is incorrect case CBSLASH: case CBSDOT: if(CSLASH==ID(f)&&(ff=VAV(f)->f,ff&&VERB&AT(ff))){ b=id==CBSDOT; switch(ID(ff)){ case CPLUS: R eval(b ? "<:/~@(i.@$)" : ">:/~@(i.@$)"); }} break; ----- */ case CFCONS: R atop(amp(ds(CDOLLAR),zero),ds(CDOLLAR)); case CQQ: if(NUMERIC&AT(f)&&ng){ z=atop(amp(ds(CDOLLAR),zero),ds(CDOLLAR)); R RMAX<mr(w)?z:qq(z,g); } if(vf&&ng)R qq(diff(f),g); break; case CAT: case CAMP: if(vf&&ng)R qq(df1(g,f),ainf); if(vf&&vg)R folk(diff(g),eval("+/ .*"),atop(diff(f),g)); break; case CFORK: df=diff(f); h=v->h; dh=diff(h); switch(ID(g)){ case CPLUS: R fplus(df,dh); case CMINUS: R fminus(df,dh); case CSTAR: R fplus(ftymes(df,h),ftymes(f,dh)); case CDIV: R folk(fminus(ftymes(df,h),ftymes(f,dh)), ds(CDIV), atop(ds(CSTARCO),h)); }} R 0; } static F1(jtintg){ASSERT(0,EVNONCE);} static A jtdtab(J jt,A a,I d){A h;V*v; RZ(a); if(CDCAP==ID(a)&&(v=VAV(a),NOUN&AT(v->f)&&d==i0(v->g))){h=VAV(a)->h; R*(1+AAV(h));} switch(SGN(d)){ default: ASSERTSYS(0,"dtab"); case -1: R dtab(intg(a),d+1); case 0: R a; case 1: R dtab(diff(a),d-1); }} static DF2(jtsslope){A fs,f0,p,y,z,*zv;I m,n,r,t;V*sv=VAV(self); PREF2(jtsslope); fs=sv->f; m=*AV(sv->g); RZ(fs=1<m?dcapco(fs,sc(m-1)):atop(fs,ds(CRIGHT))); r=AR(a); n=AN(w); ASSERT(!r||r==AR(w)&&!memcmp(AS(a),AS(w),r*SZI),EVNONCE); RZ(f0=df2(a,w,fs)); GA(z,BOX,n,AR(w),AS(w)); zv=AAV(z); t=CMPX&AT(a)||CMPX&AT(w)?CMPX:FL; RZ(a=cvt(t,a)); RZ(y=cvt(t,w)); GA(p,t,1,0,0); if(t&CMPX){Z*av=ZAV(a),e,*pv=ZAV(p),*v=ZAV(y),x; e.re=1e-7; e.im=0.0; *pv=ZNZ(*av)?*av:e; DO(n, if(r)*pv=ZNZ(av[i])?av[i]:e; x=v[i]; v[i]=zplus(v[i],*pv); RZ(zv[i]=divide(minus(df2(p,y,fs),f0),p)); v[i]=x;); }else {D*av=DAV(a),e,*pv=DAV(p),*v=DAV(y),x; e=1e-7; *pv= *av ?*av:e; DO(n, if(r)*pv= av[i] ?av[i]:e; x=v[i]; v[i]+=*pv; RZ(zv[i]=divide(minus(df2(p,y,fs),f0),p)); v[i]=x;); } R ope(z); /* cant2(IX(AR(w)),ope(z)); */ } static DF1(jtderiv1){A e,ff,fs,gs,s,t,z,*zv;I*gv,d,n,*tv;V*v; PREF1(jtderiv1); v=VAV(self); RZ(fs=fix(v->f)); gs=v->g; n=AN(gs); gv=AV(gs); if(!(AT(w)&FL+CMPX))RZ(w=cvt(FL,w)); RZ(e=scf((D)1e-7)); RZ(t=sc(0L)); tv=AV(t); RZ(s=ca(self)); v=VAV(s); v->g=t; v->lr=v->mr; GA(z,BOX,n,AR(gs),AS(gs)); zv=AAV(z); DO(n, *tv=d=gv[i]; zv[i]=(ff=dtab(fs,d))?df1(w,ff):sslope(tymes(e,w),w,s);); RE(0); R ope(z); } F2(jtdcap){A z;I r,*v; RZ(a&&w); ASSERT(NOUN&AT(w),EVDOMAIN); RZ(w=vi(w)); v=AV(w); DO(AN(w), ASSERT(0<=v[i],EVNONCE);); if(NOUN&AT(a))R vger2(CDCAP,a,w); r=mr(a); R !AR(w)&&nameless(a)&&(z=dtab(a,*v))?z:CDERIV(CDCAP,jtderiv1,0L,r,0L,r); } F2(jtdcapco){I r,*v; ASSERTVN(a,w); RZ(w=vi(w)); v=AV(w); DO(AN(w), ASSERT(0<=v[i],EVNONCE);); r=mr(a); R CDERIV(CDCAPCO,0L,jtsslope,0L,r,r); }