Mercurial > octave
annotate scripts/general/quadl.m @ 12802:412882f498b4
codesprint: Wrote 5 tests for quadl.m
author | David Wells <drwells@vt.edu> |
---|---|
date | Sat, 16 Jul 2011 12:52:47 -0500 |
parents | f96b9b9f141b |
children | 85dac13a911b |
rev | line source |
---|---|
11523 | 1 ## Copyright (C) 1998-2011 Walter Gautschi |
5837 | 2 ## |
3 ## This file is part of Octave. | |
4 ## | |
5 ## Octave is free software; you can redistribute it and/or modify it | |
6 ## under the terms of the GNU General Public License as published by | |
7016 | 7 ## the Free Software Foundation; either version 3 of the License, or (at |
8 ## your option) any later version. | |
5837 | 9 ## |
10 ## Octave is distributed in the hope that it will be useful, but | |
11 ## WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 ## General Public License for more details. | |
14 ## | |
15 ## You should have received a copy of the GNU General Public License | |
7016 | 16 ## along with Octave; see the file COPYING. If not, see |
17 ## <http://www.gnu.org/licenses/>. | |
5837 | 18 |
19 ## -*- texinfo -*- | |
10793
be55736a0783
Grammarcheck the documentation from m-files.
Rik <octave@nomad.inbox5.com>
parents:
10791
diff
changeset
|
20 ## @deftypefn {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}) |
5837 | 21 ## @deftypefnx {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}, @var{tol}) |
22 ## @deftypefnx {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}) | |
23 ## @deftypefnx {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}, @var{p1}, @var{p2}, @dots{}) | |
24 ## | |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
25 ## Numerically evaluate the integral of @var{f} from @var{a} to @var{b} |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
26 ## using an adaptive Lobatto rule. |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
27 ## @var{f} is a function handle, inline function, or string |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
28 ## containing the name of the function to evaluate. |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
29 ## The function @var{f} must be vectorized and return a vector of output values |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
30 ## if given a vector of input values. |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
31 ## |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
32 ## @var{a} and @var{b} are the lower and upper limits of integration. Both |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
33 ## limits must be finite. |
5837 | 34 ## |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
35 ## The optional argument @var{tol} defines the relative tolerance with which |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
36 ## to perform the integration. The default value is @code{eps}. |
5837 | 37 ## |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
38 ## The algorithm used by @code{quadl} involves recursively subdividing the |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
39 ## integration interval. |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
40 ## If @var{trace} is defined then for each subinterval display: (1) the left |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
41 ## end of the subinterval, (2) the length of the subinterval, (3) the |
12642
f96b9b9f141b
doc: Periodic grammarcheck and spellcheck of documentation.
Rik <octave@nomad.inbox5.com>
parents:
12612
diff
changeset
|
42 ## approximation of the integral over the subinterval. |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
43 ## |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
44 ## Additional arguments @var{p1}, etc., are passed directly to the function |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
45 ## @var{f}. To use default values for @var{tol} and @var{trace}, one may pass |
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
46 ## empty matrices ([]). |
5837 | 47 ## |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
48 ## Reference: W. Gander and W. Gautschi, @cite{Adaptive Quadrature - |
10791
3140cb7a05a1
Add spellchecker scripts for Octave and run spellcheck of documentation
Rik <octave@nomad.inbox5.com>
parents:
10549
diff
changeset
|
49 ## Revisited}, BIT Vol. 40, No. 1, March 2000, pp. 84--101. |
5837 | 50 ## @url{http://www.inf.ethz.ch/personal/gander/} |
12575
d0b799dafede
Grammarcheck files for 3.4.1 release.
Rik <octave@nomad.inbox5.com>
parents:
11587
diff
changeset
|
51 ## @seealso{quad, quadv, quadgk, quadcc, trapz, dblquad, triplequad} |
5837 | 52 ## @end deftypefn |
53 | |
54 ## Author: Walter Gautschi | |
55 ## Date: 08/03/98 | |
56 ## Reference: Gander, Computermathematik, Birkhaeuser, 1992. | |
57 | |
58 ## 2003-08-05 Shai Ayal | |
59 ## * permission from author to release as GPL | |
60 ## 2004-02-10 Paul Kienzle | |
61 ## * renamed to quadl for compatibility | |
62 ## * replace global variable terminate2 with local function need_warning | |
63 ## * add paper ref to docs | |
64 | |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
65 function q = quadl (f, a, b, tol, trace, varargin) |
5838 | 66 need_warning (1); |
5837 | 67 if (nargin < 4) |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
68 tol = []; |
5837 | 69 endif |
70 if (nargin < 5) | |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
71 trace = []; |
5837 | 72 endif |
7795
df9519e9990c
Handle single precision eps values
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
73 if (isa (a, "single") || isa (b, "single")) |
df9519e9990c
Handle single precision eps values
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
74 myeps = eps ("single"); |
df9519e9990c
Handle single precision eps values
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
75 else |
df9519e9990c
Handle single precision eps values
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
76 myeps = eps; |
df9519e9990c
Handle single precision eps values
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
77 endif |
5838 | 78 if (isempty (tol)) |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
79 tol = myeps; |
5837 | 80 endif |
5838 | 81 if (isempty (trace)) |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
82 trace = 0; |
5837 | 83 endif |
7795
df9519e9990c
Handle single precision eps values
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
84 if (tol < myeps) |
df9519e9990c
Handle single precision eps values
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
85 tol = myeps; |
5837 | 86 endif |
87 | |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
88 m = (a+b)/2; |
5837 | 89 h = (b-a)/2; |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
90 alpha = sqrt(2/3); |
5837 | 91 beta = 1/sqrt(5); |
5838 | 92 |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
93 x1 = .942882415695480; |
5837 | 94 x2 = .641853342345781; |
95 x3 = .236383199662150; | |
5838 | 96 |
97 x = [a, m-x1*h, m-alpha*h, m-x2*h, m-beta*h, m-x3*h, m, m+x3*h, ... | |
98 m+beta*h, m+x2*h, m+alpha*h, m+x1*h, b]; | |
99 | |
100 y = feval (f, x, varargin{:}); | |
101 | |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
102 fa = y(1); |
5837 | 103 fb = y(13); |
5838 | 104 |
105 i2 = (h/6)*(y(1) + y(13) + 5*(y(5)+y(9))); | |
106 | |
107 i1 = (h/1470)*(77*(y(1)+y(13)) | |
10549 | 108 + 432*(y(3)+y(11)) |
109 + 625*(y(5)+y(9)) | |
110 + 672*y(7)); | |
5838 | 111 |
112 is = h*(.0158271919734802*(y(1)+y(13)) | |
10549 | 113 +.0942738402188500*(y(2)+y(12)) |
114 + .155071987336585*(y(3)+y(11)) | |
115 + .188821573960182*(y(4)+y(10)) | |
116 + .199773405226859*(y(5)+y(9)) | |
117 + .224926465333340*(y(6)+y(8)) | |
118 + .242611071901408*y(7)); | |
5838 | 119 |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
120 s = sign(is); |
5838 | 121 |
122 if (s == 0) | |
123 s = 1; | |
5837 | 124 endif |
125 erri1 = abs(i1-is); | |
126 erri2 = abs(i2-is); | |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
127 R = 1; |
5837 | 128 if (erri2 != 0) |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
129 R = erri1/erri2; |
5837 | 130 endif |
131 if (R > 0 && R < 1) | |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
132 tol = tol/R; |
5837 | 133 endif |
7795
df9519e9990c
Handle single precision eps values
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
134 is = s*abs(is)*tol/myeps; |
5837 | 135 if (is == 0) |
136 is = b-a; | |
137 endif | |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
138 q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin{:}); |
5837 | 139 endfunction |
140 | |
141 ## ADAPTLOBSTP Recursive function used by QUADL. | |
142 ## | |
5838 | 143 ## Q = ADAPTLOBSTP('F', A, B, FA, FB, IS, TRACE) tries to |
5837 | 144 ## approximate the integral of F(X) from A to B to |
145 ## an appropriate relative error. The argument 'F' is | |
146 ## a string containing the name of f. The remaining | |
147 ## arguments are generated by ADAPTLOB or by recursion. | |
148 ## | |
149 ## Walter Gautschi, 08/03/98 | |
150 | |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
151 function q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin) |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
152 h = (b-a)/2; |
5837 | 153 m = (a+b)/2; |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
154 alpha = sqrt(2/3); |
5837 | 155 beta = 1/sqrt(5); |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
156 mll = m-alpha*h; |
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
157 ml = m-beta*h; |
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
158 mr = m+beta*h; |
5837 | 159 mrr = m+alpha*h; |
5838 | 160 x = [mll, ml, m, mr, mrr]; |
161 y = feval(f, x, varargin{:}); | |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
162 fmll = y(1); |
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
163 fml = y(2); |
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
164 fm = y(3); |
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
165 fmr = y(4); |
5837 | 166 fmrr = y(5); |
5838 | 167 i2 = (h/6)*(fa + fb + 5*(fml+fmr)); |
168 i1 = (h/1470)*(77*(fa+fb) + 432*(fmll+fmrr) + 625*(fml+fmr) + 672*fm); | |
169 if (is+(i1-i2) == is || mll <= a || b <= mrr) | |
170 if ((m <= a || b <= m) && need_warning ()) | |
171 warning ("quadl: interval contains no more machine number"); | |
172 warning ("quadl: required tolerance may not be met"); | |
173 need_warning (0); | |
5837 | 174 endif |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
175 q = i1; |
5837 | 176 if (trace) |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
177 disp ([a, b-a, q]); |
5837 | 178 endif |
179 else | |
12612
16cca721117b
doc: Update all documentation for chapter on Numerical Integration
Rik <octave@nomad.inbox5.com>
parents:
12575
diff
changeset
|
180 q = (adaptlobstp (f, a, mll, fa, fmll, is, trace, varargin{:}) |
10549 | 181 + adaptlobstp (f, mll, ml, fmll, fml, is, trace, varargin{:}) |
182 + adaptlobstp (f, ml, m, fml, fm, is, trace, varargin{:}) | |
183 + adaptlobstp (f, m, mr, fm, fmr, is, trace, varargin{:}) | |
184 + adaptlobstp (f, mr, mrr, fmr, fmrr, is, trace, varargin{:}) | |
185 + adaptlobstp (f, mrr, b, fmrr, fb, is, trace, varargin{:})); | |
5837 | 186 endif |
187 endfunction | |
188 | |
5838 | 189 function r = need_warning (v) |
5837 | 190 persistent w = []; |
191 if (nargin == 0) | |
192 r = w; | |
11587
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
193 else |
c792872f8942
all script files: untabify and strip trailing whitespace
John W. Eaton <jwe@octave.org>
parents:
11562
diff
changeset
|
194 w = v; |
5837 | 195 endif |
196 endfunction | |
12802
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
197 |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
198 |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
199 ## basic functionality |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
200 %!assert( quadl (@(x) sin (x), 0, pi, [], []), 2, -3e-16) |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
201 |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
202 ## the values here are very high so it may be unavoidable that this fails |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
203 %!assert ( quadl (@(x) sin (3*x).*cosh (x).*sinh (x),10,15), |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
204 %! 2.588424538641647e+10, -9e-15) |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
205 |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
206 ## extra parameters |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
207 %!assert (quadl (@(x,a,b) sin (a + b*x), 0, 1, [], [], 2, 3), |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
208 %! cos(2)/3 - cos(5)/3, - 3e-16) |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
209 |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
210 ## test different tolerances. This test currently fails for a very high |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
211 ## tolerances. |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
212 %!assert ( quadl (@(x) sin (2 + 3*x).^2, 0, 10, 0.3, []), |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
213 %! (60 + sin(4) - sin(64))/12, -0.3) |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
214 |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
215 |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
216 ## for lower tolerances the test passes. |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
217 %!assert ( quadl (@(x) sin (2 + 3*x).^2, 0, 10, 0.1, []), |
412882f498b4
codesprint: Wrote 5 tests for quadl.m
David Wells <drwells@vt.edu>
parents:
12642
diff
changeset
|
218 %! (60 + sin(4) - sin(64))/12, -0.1) |