Mercurial > hg > jgplsrc

annotate cd.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 /* Conjunctions: Differentiation and Integration */
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 B jtiscons(J jt,A w){A x;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11 v=VAV(w); x=v->f;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 R CQQ==v->id&&NOUN&AT(x)&&!AR(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 static C ispoly1[]={CLEFT,CRIGHT,CLE,CGE,CNOT,CMINUS,CPLUSCO,CHALVE,CCIRCLE,CJDOT,0};
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 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;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 v=VAV(w); id=v->id;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 if(id==CFCONS||iscons(w))R 1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21 if(strchr(ispoly1,id))R 2;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 if(id==CSTARCO)R 3;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 f=v->f; nf=f&&NOUN&AT(f); vf=!nf;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 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;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 if(id==CFORK){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 RZ(vf&&vg);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 m=ispoly(f); n=ispoly(v->h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 switch(m&&n?ID(g):0){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 case CPLUS: R MAX(m,n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 case CSTAR: R m+n-1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 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);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 RZ(id==CAMP&&(t&NUMERIC||c==CPOLY));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34 if(nf&&1>=AR(x)&&c==CPOLY){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 RZ(t&BOX+NUMERIC);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 k=IC(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 if(t&NUMERIC)R k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 y=*(AAV(x)+k-1); RZ(2>=AR(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 if(1>=AR(y))R 1+IC(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 RZ(2==*(1+AS(y)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 RZ(e=irs1(y,0L,1L,jttail));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 RZ(equ(e,floor1(e))&&all1(le(zero,e)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 RZ(y=aslash(CMAX,cvt(INT,e)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 R 1+*AV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 if(nf==ng||AR(x))R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 if(c==CPLUS||c==CMINUS||c==CSTAR||c==CDIV&&ng)R 2;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 RZ(x=pcvt(INT,x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 if(!(INT&AT(x)))R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 k=*AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 R 0<=k&&(c==CBANG&&nf||c==CEXP&&ng)?1+k:0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52 } /* 1 + degree of polynomial (0 if not poly) */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 static F1(jtfpolyc){A b;B*bv;I m,n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 RZ(b=ne(w,zero)); bv=BAV(b);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 m=n=AN(w); DO(n, if(bv[--m])break;); ++m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 if(m<n)RZ(w=take(sc(m),w)); n=m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 switch(n){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 case 1: R qq(head(w),zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 case 3: if(equ(w,over(v2(0L,0L),one)))R ds(CSTARCO); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 case 2:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 if(equ(w,v2( 0L,-1L))) R ds(CMINUS);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 if(equ(w,v2( 1L,-1L))) R ds(CNOT);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 if(equ(w,v2(-1L, 1L))) R ds(CLE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 if(equ(w,v2( 0L, 1L))) R ds(CLEFT);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 if(equ(w,v2( 1L, 1L))) R ds(CGE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 if(equ(w,v2( 0L, 2L))) R ds(CPLUSCO);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 if(equ(w,over(zero,scf((D)0.5))))R ds(CHALVE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69 if(equ(w,over(zero,scf(PI ))))R ds(CCIRCLE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 if(equ(w,over(zero,a0j1 )))R ds(CJDOT);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 R amp(w,ds(CPOLY));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 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)));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 static F1(jtfnegate){V*v; RZ(w); v=VAV(w); R CAT==v->id&&CMINUS==ID(v->f)?v->g:atop(ds(CMINUS),w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 static F2(jtfplus){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 if(iscons(a)&&equ(VAV(a)->f,zero))R w;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 if(iscons(w)&&equ(VAV(w)->f,zero))R a;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 R folk(a,ds(CPLUS),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 static F2(jtfminus){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 if(iscons(a)&&equ(VAV(a)->f,zero))R fnegate(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 if(iscons(w)&&equ(VAV(w)->f,zero))R a;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 R folk(a,ds(CMINUS),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 static F2(jtftymes){A x,y;B b,c;I k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 b=iscons(a); x=VAV(a)->f;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 c=iscons(w); y=VAV(w)->f;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97 if(CFORK==ID(w)&&NOUN&AT(y))R ftymes(a,folk(qq(y,ainf),VAV(w)->g,VAV(w)->h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 if(b&&AT(x)&B01+INT){k=i0(x); if(-1<=k&&k<=1)R !k?a:0<k?w:fnegate(w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 if(c&&AT(y)&B01+INT){k=i0(y); if(-1<=k&&k<=1)R !k?w:0<k?a:fnegate(a);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 if(b&&CFORK==ID(w)&&iscons(y))R ftymes(qq(tymes(x,VAV(y)->f),zero),VAV(w)->h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 R c?folk(w,ds(CSTAR),a):folk(a,ds(CSTAR),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 static F1(jtdpoly){A c,e,x;I n,t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 n=AN(w); t=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 ASSERT(!n||t&NUMERIC+BOX,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 if(!n||t&NUMERIC)R 2>=n?qq(2==n?tail(w):cvt(n?t:B01,zero),zero):fpolyc(behead(tymes(w,IX(n))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 x=AAV0(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 if(1<n||1>=AR(x))R dpoly(poly1(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 ASSERT(2==AR(x)&&2==*(1+AS(x)),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 c=irs1(x,0L,1L,jthead);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 e=irs1(x,0L,1L,jttail);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 R amp(box(stitch(tymes(c,e),minus(e,one))),ds(CPOLY));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 static F1(jtipoly){A b,c,e,p=0,q=0,x;I n,t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 n=AN(w); t=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 ASSERT(!n||t&NUMERIC+BOX,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 if(!n||t&NUMERIC)R fpolyc(over(zero,divide(w,apv(n,1L,1L))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 x=AAV0(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 if(1<n||1>=AR(x))R ipoly(poly1(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 ASSERT(2==AR(x)&&2==*(1+AS(x)),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 RZ(c=irs1(x,0L,1L,jthead));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 RZ(e=plus(one,irs1(x,0L,1L,jttail)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 RZ(b=ne(e,zero));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 if(!all0(b))RZ(p=amp(box(repeat(b,stitch(divide(c,e),e))),ds(CPOLY)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 if(!all1(b))RZ(q=evc(not(b),c,"(+/x#y)&*@^."));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 R p&&q?folk(p,ds(CPLUS),q):p?p:q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 static F1(jticube){R atco(eval("* =/~@(i.@$)"),w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135 static F1(jtdiffamp0){A f,g,h,x,y;B nf,ng;C id;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137 v=VAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 f=v->f; nf=1&&NOUN&AT(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139 g=v->g; ng=1&&NOUN&AT(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140 h=nf?g:f; id=ID(h); x=nf?f:g;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141 RZ(!AR(x)||id==CPOLY);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
142 switch(id){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
143 case CPLUS: R qq(one,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
144 case CSTAR: R qq(x,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
145 case CMINUS: R qq(num[nf?-1:1],zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
146 case CDIV: R nf?eva(x,"(-x)&%@*:"):qq(recip(x),zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
147 case CPOLY: if(nf)R dpoly(x); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
148 case CBANG: if(nf&&!AR(x))R dpoly(df1(iota(increm(x)),tdot(w))); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
149 case CROOT: if(nf&&!AR(x))R atop(amp(recip(x),ds(CSTAR)),amp(ds(CEXP),decrem(recip(x)))); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
150 case CLOG: R eva(logar1(x),nf?"(%x)&%":"(-x)&%@(* *:@^.)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
151 case CEXP:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
152 if(nf)R evc(x,w,"(^.x)&*@y");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
153 RZ(y=pcvt(INT,x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
154 if(INT&AT(y))switch(*AV(y)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
155 case 0: R qq(zero,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
156 case 1: R qq(one,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
157 case 2: R ds(CPLUSCO);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
158 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
159 R eva(x,"x&*@(^&(x-1))");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
160 case CCIRCLE:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
161 if(nf){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
162 RZ(x=vi(x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
163 switch(*AV(x)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
164 case 0: R folk(ds(CMINUS),ds(CDIV),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
165 case 1: R amp(num[2],h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
166 case 2: R atop(ds(CMINUS),amp(one,h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
167 case 3: R atop(atop(ds(CDIV),ds(CSTARCO)),amp(num[2],h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
168 case 5: R amp(num[6],h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
169 case 6: R amp(num[5],h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
170 case 7: R atop(atop(ds(CDIV),ds(CSTARCO)),amp(num[6],h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
171 }}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
172 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
173 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
174
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
175 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;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
176 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
177 v=VAV(w); id=v->id;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
178 f=v->f; nf=f&&NOUN&AT(f); vf=f&&!nf;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
179 g=v->g; ng=g&&NOUN&AT(g); vg=g&&!ng;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
180 if(id==CAMP&&nf!=ng)R diffamp0(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
181 switch(id){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
182 case CLE:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
183 case CGE:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
184 case CLEFT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
185 case CRIGHT: R qq(one,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
186 case CPLUSCO: R qq(num[2],zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
187 case CNOT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
188 case CMINUS: R qq(num[-1],zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
189 case CFCONS: R qq(zero,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
190 case CSTARCO: R ds(CPLUSCO);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
191 case CHALVE: R qq(connum(3L,"1r2"),zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
192 case CCIRCLE: R qq(pie,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
193 case CDIV: R eval("- @%@*:");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
194 case CSQRT: R eval("-:@%@%:");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
195 case CEXP: R w;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
196 case CLOG: R ds(CDIV);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
197 case CJDOT: R qq(a0j1,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
198 case CRDOT: R atop(ds(CJDOT),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
199 case CDDOT: if(vf&&ng)R ddot(f,increm(g)); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
200 case CPOWOP:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
201 if(vf&&ng&&!AR(g))switch(p=i0(g)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
202 case -1: R diff0(inv(f));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
203 case 0: RE(0); R qq(one,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
204 case 1: R diff0(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
205 default:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
206 if(0>p){RZ(f=inv(f)); p=-p;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
207 if(q=ispoly(f)){RE(m=i0(vib(expn2(sc(q-1),g)))); R dpoly(df1(IX(1+m),tdot(w)));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
208 R diff0(atop(powop(f,sc(p-1)),f));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
209 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
210 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
211 case CQQ:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
212 if(!AR(f)&&NUMERIC&AT(f)&&ng&&equ(g,zero))R qq(zero,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
213 if(vf&&ng)R qq(diff0(f),g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
214 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
215 case CAT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
216 case CATCO:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
217 case CAMP:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
218 case CAMPCO:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
219 if(vf&&vg){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
220 p=ispoly(f); q=ispoly(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
221 if(p&&q)R dpoly(df1(IX(1+(p-1)*(q-1)),tdot(w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
222 RZ(dg=diff0(g)); RZ(df=diff0(f)); v=VAV(df); x=v->f;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
223 if(CQQ!=v->id)R ftymes(dg,atop(df,g));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
224 switch(CQQ==v->id&&AT(x)&B01+INT?i0(x):9){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
225 case 0: R df;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
226 case 1: R dg;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
227 case 2: R atop(ds(CPLUSCO),dg);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
228 case -1: R fnegate(dg);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
229 default: R ftymes(df,dg);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
230 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
231 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
232 case CTILDE:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
233 if(vf)switch(ID(f)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
234 case CPLUS: R qq(num[2],zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
235 case CSTAR: R ds(CPLUSCO);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
236 case CMINUS:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
237 case CLOG:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
238 case CDIV: R qq(zero,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
239 case CEXP: R eva(w,"x * >:@^.");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
240 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
241 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
242 case CFORK:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
243 h=v->h;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
244 if(NOUN&AT(f))R diff0(folk(qq(f,zero),g,h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
245 if(CCAP==ID(f))R diff0(atco(g,h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
246 p=ispoly(f); df=diff0(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
247 q=ispoly(h); dh=diff0(h); b=p&&q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
248 switch(ID(g)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
249 case CPLUS: z=fplus (df,dh); R b?fpoly(MAX(p,q)-1,z):z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
250 case CMINUS: z=fminus(df,dh); R b?fpoly(MAX(p,q)-1,z):z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
251 case CSTAR: z=fplus(ftymes(df,h),ftymes(f,dh)); R b?fpoly(p+q,z):z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
252 case CCOMMA: R folk(df,g,dh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
253 case CDIV: x=fminus(ftymes(df,h),ftymes(f,dh));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
254 y=atop(ds(CSTARCO),h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
255 R folk(b?fpoly(p+q-1-(p==q),x):x,ds(CDIV),q?fpoly(q+q,y):y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
256 case CEXP: if(1==q){A k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
257 RZ(k=df1(zero,h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
258 if(equ(k,zero))R qq(zero,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
259 if(equ(k,one))R df;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
260 if(equ(k,num[2]))R ftymes(df,ftymes(h,f));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
261 R ftymes(df,ftymes(h,folk(f,g,qq(decrem(k),zero))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
262 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
263 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
264 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
265 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
266
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
267 static F1(jtintgamp0){A f,g,h,x,y;B nf,ng;C id;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
268 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
269 v=VAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
270 f=v->f; nf=1&&NOUN&AT(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
271 g=v->g; ng=1&&NOUN&AT(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
272 h=nf?g:f; id=ID(h); x=nf?f:g;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
273 RZ(!AR(x)||id==CPOLY);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
274 switch(id){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
275 case CPLUS: R ipoly(over(x,one));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
276 case CSTAR: R ipoly(over(zero,x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
277 case CMINUS: R nf?ipoly(over(x,num[-1])):ipoly(over(negate(x),one));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
278 case CDIV: R nf?eva(x,"x&*@^."):ipoly(over(zero,recip(x)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
279 case CPOLY: if(nf)R ipoly(x); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
280 case CBANG: if(nf&&AT(x))R ipoly(df1(iota(increm(x)),tdot(w))); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
281 case CEXP:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
282 if(ng&&!AR(x)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
283 if(equ(x,num[-1]))R ds(CLOG);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
284 RZ(y=pcvt(INT,x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
285 R INT&AT(y)?ipoly(take(sc(-1-i0(y)),one)):atop(amp(ds(CDIV),increm(y)),amp(ds(CEXP),increm(y)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
286 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
287 case CCIRCLE:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
288 if(nf){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
289 RZ(x=vi(x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
290 switch(*AV(x)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
291 case 1: R atop(ds(CMINUS),amp(num[2],h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
292 case 2: R amp(one,h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
293 case 3: R eval("-@^.@(2&o.)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
294 case 5: R amp(num[6],h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
295 case 6: R amp(num[5],h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
296 case 7: R atop(ds(CLOG),amp(num[6],h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
297 }}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
298 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
299 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
300
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
301 static F1(jtintg0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
302
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
303 static F2(jtintgatop){A df,f=a,g=w,q,x,y;I m,n;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
304 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
305 m=ispoly(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
306 n=ispoly(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
307 if(m&&n)R ipoly(df1(IX(1+(m-1)*(n-1)),tdot(atop(a,w))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
308 if(2==m){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
309 RZ(q=v2(0L,1L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
310 RZ(x=df1(q,tdot(f)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
311 RZ(y=equ(one, tail(x))?intg0(g):atop(fpolyc(tymes(q,x)),intg0(g)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
312 R equ(zero,head(x))?y :folk(y,ds(CPLUS),amp(head(x),ds(CSTAR)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
313 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
314 if(1==n||2==n){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
315 df=atop(intg0(f),g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
316 if(1==n)R df;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
317 RZ(x=df1(one,tdot(g)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
318 R equ(x,one)?df:atop(amp(ds(CDIV),x),df);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
319 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
320 v=VAV(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
321 if(m&&equ(take(sc(-m),one),df1(IX(m),tdot(f)))){ /* ^&m @ g */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
322 if(CLOG==v->id)R 1==m?ds(CRIGHT):2==m?intg0(g):eva(sc(m-1),"(] * ^&x@^.) - x&* @(^&(x-1)@^. d. _1)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
323 if(CAMP==v->id&&CCIRCLE==ID(v->g)&&(y=v->f,!AR(y)&&equ(y,floor1(y)))){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
324 if(2>=m)R 1==m?ds(CRIGHT):intgamp0(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
325 switch(i0(y)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
326 case 1: R eva(sc(m-1),"%&(-x )@(^&(x-1)@(1&o.) * 2&o.) + ((x-1)%x)&*@(^&(x-2)@(1&o.) d. _1)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
327 case 2: R eva(sc(m-1),"%&x @(^&(x-1)@(2&o.) * 1&o.) + ((x-1)%x)&*@(^&(x-2)@(2&o.) d. _1)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
328 case 3: R eva(sc(m-1),"%&(x-1)@(^&(x-1)@(3&o.) ) - ^&(x-2)@(3&o.) d. _1 ");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
329 case 7: R eva(sc(m-1),"%&(1-x)@(^&(x-1)@(7&o.) ) + ^&(x-2)@(7&o.) d. _1 ");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
330 }}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
331 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
332 } /* integral of a @ w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
333
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
334 static F2(jtintgtymes){A f=a,g=w;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
335 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
336 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
337 } /* integral of a * w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
338
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
339 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;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
340 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
341 id=ID(w); v=VAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
342 f=v->f; nf=f&&NOUN&AT(f); if(vf=f&&!nf)fv=VAV(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
343 g=v->g; ng=g&&NOUN&AT(g); if(vg=g&&!ng)gv=VAV(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
344 if(id==CAMP&&nf!=ng)R intgamp0(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
345 switch(id){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
346 case CLE: R ipoly(v2(-1L, 1L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
347 case CGE: R ipoly(v2( 1L, 1L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
348 case CLEFT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
349 case CRIGHT: R ipoly(v2( 0L, 1L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
350 case CNOT: R ipoly(v2( 1L,-1L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
351 case CMINUS: R ipoly(v2( 0L,-1L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
352 case CPLUSCO: R ds(CSTARCO);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
353 case CFCONS: R amp(v->h,ds(CSTAR));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
354 case CSTARCO: R ipoly(over(v2(0L,0L),one));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
355 case CHALVE: R ipoly(over(zero,scf((D)0.5)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
356 case CCIRCLE: R ipoly(over(zero,scf(PI )));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
357 case CDIV: R ds(CLOG);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
358 case CSQRT: R eval("%: * (0 2%3)&p.");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
359 case CEXP: R w;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
360 case CLOG: R eval("(]*^.) - ]");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
361 case CJDOT: R ipoly(over(zero,a0j1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
362 case CRDOT: R eval("-@j.@r.");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
363 case CDDOT: if(vf&&ng)R ddot(f,decrem(g)); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
364 case CPOWOP:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
365 if(vf&&ng&&!AR(g))switch(p=i0(g)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
366 case -1: R intg0(inv(f));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
367 case 0: RE(0); R ipoly(v2(0L,1L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
368 case 1: R intg0(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
369 default:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
370 if(0>p){RZ(f=inv(f)); p=-p;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
371 if(q=ispoly(f)){RE(m=i0(vib(expn2(sc(q-1),g)))); R ipoly(df1(IX(1+m),tdot(w)));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
372 R intg0(atop(powop(f,sc(p-1)),f));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
373 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
374 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
375 case CQQ:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
376 if(!AR(f)&&NUMERIC&AT(f)&&ng&&equ(g,zero))R amp(f,ds(CSTAR));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
377 if(vf&&ng)R qq(intg0(f),g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
378 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
379 case CAT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
380 case CATCO:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
381 case CAMP:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
382 case CAMPCO:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
383 if(vf&&vg)R intgatop(f,g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
384 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
385 case CTILDE:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
386 if(vf)switch(ID(f)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
387 case CPLUS: R ipoly(v2(0L,2L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
388 case CSTAR: R ipoly(over(v2(0L,0L),one));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
389 case CMINUS: R FCONS(zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
390 case CLOG:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
391 case CDIV: R ds(CRIGHT);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
392 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
393 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
394 case CFORK:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
395 h=v->h;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
396 if(NOUN&AT(f))R intg0(folk(qq(f,zero),g,h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
397 dh=intg0(h); n=ispoly(h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
398 df=intg0(f); m=ispoly(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
399 switch(ID(g)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
400 case CPLUS: R m&&n ? (p=MAX(m,n),ipoly(df1(IX(p),tdot(w)))) : fplus(df,dh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
401 case CMINUS: R m&&n ? (p=MAX(m,n),ipoly(df1(IX(p),tdot(w)))) : fminus(df,dh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
402 case CSTAR: if(m&&n){p=2+(m-1)*(n-1); R ipoly(df1(IX(p),tdot(w)));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
403 R intgtymes(f,h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
404 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
405 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
406 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
407
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
408 static DF1(jtddot1){V*v=VAV(self); R df1(w,ddot(fix(v->f),v->g));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
409
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
410 F2(jtddot){A x,*xv,y,z;AF f;I j,n,p,q,r,*wv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
411 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
412 ASSERT(NOUN&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
413 RZ(w=vi(w)); r=AR(w); n=AN(w); wv=AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
414 if(NOUN&AT(a)){ASSERT(0,EVNONCE);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
415 if(!nameless(a)||1<r)R CDERIV(CDDOT, jtddot1,0L, 0L,0L,0L);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
416 irange(n,wv,&p,&q);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
417 if(!r){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
418 if(!p){V*v=VAV(a); R v->mr||v->lr||v->rr?qq(a,zero):a;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
419 f=0<=p?jtdiff0:jtintg0; y=a; DO(ABS(p), ASSERT(y=CALL1(f,y,0L),EVDOMAIN);); R y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
420 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
421 q+=p-1; p=0>p?p:0; q=0<q?q:0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
422 GA(x,BOX,1+q-p,1,0); xv=AAV(x); xv[-p]=a;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
423 if(0>p){y=a; j=-p; DO(-p, ASSERT(y=intg0(y),EVDOMAIN); xv[--j]=y;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
424 if(0<q){y=a; j=-p; DO( q, ASSERT(y=diff0(y),EVDOMAIN); xv[++j]=y;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
425 j=n; z=xv[wv[--j]-p]; DO(n-1, RZ(z=folk(xv[wv[--j]-p],ds(CCOMMA),z)););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
426 R qq(z,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
427 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
428
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
429
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
430 static F1(jtdiffamp){A f,g,h,x,y;B nf,ng;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
431 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
432 v=VAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
433 f=v->f; nf=1&&NOUN&AT(f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
434 g=v->g; ng=1&&NOUN&AT(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
435 h=nf?g:f; x=nf?f:g;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
436 switch(ID(h)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
437 case CROT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
438 case CCANT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
439 case CLBRACE:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
440 case CATOMIC:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
441 case CCYCLE:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
442 if(nf)R atop(hook(eval("=/"),w),eval("i.@$"));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
443 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
444 case CPOLY:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
445 if(nf&&1>=AR(x))R dpoly(NUMERIC&AT(x)?x:poly1(x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
446 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
447 case CBANG:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
448 if(!AR(x)&&(x=pcvt(INT,x),INT&AT(x)))R dpoly(df1(IX(1+*AV(x)),tdot(w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
449 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
450 case CFIT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
451 if(nf&&1>=AR(x)&&(y=VAV(h)->f,CPOLY==ID(y)))R dpoly(df1(IX(IC(x)),tdot(w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
452 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
453 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
454 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
455
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
456 static F1(jtdiff){A df,dh,f,g,h,z;B nf,ng,vf,vg;C id;I r;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
457 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
458 ASSERT(VERB&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
459 v=VAV(w); id=v->id; r=v->mr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
460 f=v->f; nf=f&&NOUN&AT(f); vf=f&&!nf;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
461 g=v->g; ng=g&&NOUN&AT(g); vg=g&&!ng;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
462 if(nf&&id==CFORK)R diff(folk(qq(f,ainf),g,v->h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
463 if(z=diff0(w))R id==CQQ&&ng&&equ(g,zero)?z:icube(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
464 if(id==CAMP&&nf!=ng)R diffamp(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
465 switch(id){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
466 case CREV: R eval("(|.=/])@(i.@$)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
467 case CCANT: R eval("(|:=/])@(i.@$)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
468 case CHGEOM: R hgdiff(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
469 case CSLASH:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
470 switch(ID(f)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
471 case CPLUS: R eval("({. =/ */@}.@$ | ])@(i.@$)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
472 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
473 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
474 /* ----- commented out because it is incorrect
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
475 case CBSLASH:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
476 case CBSDOT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
477 if(CSLASH==ID(f)&&(ff=VAV(f)->f,ff&&VERB&AT(ff))){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
478 b=id==CBSDOT;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
479 switch(ID(ff)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
480 case CPLUS: R eval(b ? "<:/~@(i.@$)" : ">:/~@(i.@$)");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
481 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
482 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
483 ----- */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
484 case CFCONS:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
485 R atop(amp(ds(CDOLLAR),zero),ds(CDOLLAR));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
486 case CQQ:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
487 if(NUMERIC&AT(f)&&ng){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
488 z=atop(amp(ds(CDOLLAR),zero),ds(CDOLLAR));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
489 R RMAX<mr(w)?z:qq(z,g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
490 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
491 if(vf&&ng)R qq(diff(f),g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
492 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
493 case CAT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
494 case CAMP:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
495 if(vf&&ng)R qq(df1(g,f),ainf);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
496 if(vf&&vg)R folk(diff(g),eval("+/ .*"),atop(diff(f),g));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
497 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
498 case CFORK:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
499 df=diff(f); h=v->h; dh=diff(h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
500 switch(ID(g)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
501 case CPLUS: R fplus(df,dh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
502 case CMINUS: R fminus(df,dh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
503 case CSTAR: R fplus(ftymes(df,h),ftymes(f,dh));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
504 case CDIV: R folk(fminus(ftymes(df,h),ftymes(f,dh)), ds(CDIV), atop(ds(CSTARCO),h));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
505 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
506 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
507 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
508
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
509 static F1(jtintg){ASSERT(0,EVNONCE);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
510
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
511 static A jtdtab(J jt,A a,I d){A h;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
512 RZ(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
513 if(CDCAP==ID(a)&&(v=VAV(a),NOUN&AT(v->f)&&d==i0(v->g))){h=VAV(a)->h; R*(1+AAV(h));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
514 switch(SGN(d)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
515 default: ASSERTSYS(0,"dtab");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
516 case -1: R dtab(intg(a),d+1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
517 case 0: R a;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
518 case 1: R dtab(diff(a),d-1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
519 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
520
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
521
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
522 static DF2(jtsslope){A fs,f0,p,y,z,*zv;I m,n,r,t;V*sv=VAV(self);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
523 PREF2(jtsslope);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
524 fs=sv->f; m=*AV(sv->g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
525 RZ(fs=1<m?dcapco(fs,sc(m-1)):atop(fs,ds(CRIGHT)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
526 r=AR(a); n=AN(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
527 ASSERT(!r||r==AR(w)&&!memcmp(AS(a),AS(w),r*SZI),EVNONCE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
528 RZ(f0=df2(a,w,fs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
529 GA(z,BOX,n,AR(w),AS(w)); zv=AAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
530 t=CMPX&AT(a)||CMPX&AT(w)?CMPX:FL;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
531 RZ(a=cvt(t,a)); RZ(y=cvt(t,w)); GA(p,t,1,0,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
532 if(t&CMPX){Z*av=ZAV(a),e,*pv=ZAV(p),*v=ZAV(y),x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
533 e.re=1e-7; e.im=0.0; *pv=ZNZ(*av)?*av:e;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
534 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;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
535 }else {D*av=DAV(a),e,*pv=DAV(p),*v=DAV(y),x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
536 e=1e-7; *pv= *av ?*av:e;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
537 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;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
538 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
539 R ope(z); /* cant2(IX(AR(w)),ope(z)); */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
540 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
541
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
542 static DF1(jtderiv1){A e,ff,fs,gs,s,t,z,*zv;I*gv,d,n,*tv;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
543 PREF1(jtderiv1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
544 v=VAV(self); RZ(fs=fix(v->f)); gs=v->g; n=AN(gs); gv=AV(gs);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
545 if(!(AT(w)&FL+CMPX))RZ(w=cvt(FL,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
546 RZ(e=scf((D)1e-7));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
547 RZ(t=sc(0L)); tv=AV(t);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
548 RZ(s=ca(self)); v=VAV(s); v->g=t; v->lr=v->mr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
549 GA(z,BOX,n,AR(gs),AS(gs)); zv=AAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
550 DO(n, *tv=d=gv[i]; zv[i]=(ff=dtab(fs,d))?df1(w,ff):sslope(tymes(e,w),w,s););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
551 RE(0); R ope(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
552 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
553
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
554 F2(jtdcap){A z;I r,*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
555 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
556 ASSERT(NOUN&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
557 RZ(w=vi(w)); v=AV(w); DO(AN(w), ASSERT(0<=v[i],EVNONCE););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
558 if(NOUN&AT(a))R vger2(CDCAP,a,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
559 r=mr(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
560 R !AR(w)&&nameless(a)&&(z=dtab(a,*v))?z:CDERIV(CDCAP,jtderiv1,0L,r,0L,r);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
561 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
562
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
563 F2(jtdcapco){I r,*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
564 ASSERTVN(a,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
565 RZ(w=vi(w)); v=AV(w); DO(AN(w), ASSERT(0<=v[i],EVNONCE););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
566 r=mr(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
567 R CDERIV(CDCAPCO,0L,jtsslope,0L,r,r);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
568 }