annotate scripts/polynomial/pchip.m @ 11472:1740012184f9

Use uppercase for variable names in error() strings to match Info documentation. Only m-files done.
author Rik <octave@nomad.inbox5.com>
date Sun, 09 Jan 2011 21:33:04 -0800
parents be55736a0783
children fd0a3ac60b0e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
8920
eb63fbe60fab update copyright notices
John W. Eaton <jwe@octave.org>
parents: 8664
diff changeset
1 ## Copyright (C) 2001, 2002, 2006, 2007, 2008, 2009 Kai Habel
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
2 ##
6440
98ee80702bca [project @ 2007-03-23 15:13:19 by jwe]
jwe
parents: 5838
diff changeset
3 ## This file is part of Octave.
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
4 ##
6440
98ee80702bca [project @ 2007-03-23 15:13:19 by jwe]
jwe
parents: 5838
diff changeset
5 ## Octave is free software; you can redistribute it and/or modify it
98ee80702bca [project @ 2007-03-23 15:13:19 by jwe]
jwe
parents: 5838
diff changeset
6 ## under the terms of the GNU General Public License as published by
7016
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 7001
diff changeset
7 ## the Free Software Foundation; either version 3 of the License, or (at
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 7001
diff changeset
8 ## your option) any later version.
6440
98ee80702bca [project @ 2007-03-23 15:13:19 by jwe]
jwe
parents: 5838
diff changeset
9 ##
98ee80702bca [project @ 2007-03-23 15:13:19 by jwe]
jwe
parents: 5838
diff changeset
10 ## Octave is distributed in the hope that it will be useful, but
98ee80702bca [project @ 2007-03-23 15:13:19 by jwe]
jwe
parents: 5838
diff changeset
11 ## WITHOUT ANY WARRANTY; without even the implied warranty of
98ee80702bca [project @ 2007-03-23 15:13:19 by jwe]
jwe
parents: 5838
diff changeset
12 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
98ee80702bca [project @ 2007-03-23 15:13:19 by jwe]
jwe
parents: 5838
diff changeset
13 ## General Public License for more details.
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
14 ##
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
15 ## You should have received a copy of the GNU General Public License
7016
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 7001
diff changeset
16 ## along with Octave; see the file COPYING. If not, see
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 7001
diff changeset
17 ## <http://www.gnu.org/licenses/>.
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
18
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
19 ## -*- texinfo -*-
10793
be55736a0783 Grammarcheck the documentation from m-files.
Rik <octave@nomad.inbox5.com>
parents: 9768
diff changeset
20 ## @deftypefn {Function File} {@var{pp} =} pchip (@var{x}, @var{y})
7650
eb7bdde776f2 Texinfo fixes
John W. Eaton <jwe@octave.org>
parents: 7017
diff changeset
21 ## @deftypefnx {Function File} {@var{yi} =} pchip (@var{x}, @var{y}, @var{xi})
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
22 ##
9051
1bf0ce0930be Grammar check TexInfo in all .m files
Rik <rdrider0-list@yahoo.com>
parents: 8920
diff changeset
23 ## Piecewise Cubic Hermite interpolating polynomial. Called with two
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
24 ## arguments, the piece-wise polynomial @var{pp} is returned, that may
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
25 ## later be used with @code{ppval} to evaluate the polynomial at
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
26 ## specific points.
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
27 ##
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
28 ## The variable @var{x} must be a strictly monotonic vector (either
9051
1bf0ce0930be Grammar check TexInfo in all .m files
Rik <rdrider0-list@yahoo.com>
parents: 8920
diff changeset
29 ## increasing or decreasing). While @var{y} can be either a vector or
1bf0ce0930be Grammar check TexInfo in all .m files
Rik <rdrider0-list@yahoo.com>
parents: 8920
diff changeset
30 ## array. In the case where @var{y} is a vector, it must have a length
1bf0ce0930be Grammar check TexInfo in all .m files
Rik <rdrider0-list@yahoo.com>
parents: 8920
diff changeset
31 ## of @var{n}. If @var{y} is an array, then the size of @var{y} must
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
32 ## have the form
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
33 ## @tex
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
34 ## $$[s_1, s_2, \cdots, s_k, n]$$
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
35 ## @end tex
8517
81d6ab3ac93c Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents: 7650
diff changeset
36 ## @ifnottex
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
37 ## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n}]}
8517
81d6ab3ac93c Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents: 7650
diff changeset
38 ## @end ifnottex
7001
8b0cfeb06365 [project @ 2007-10-10 18:02:59 by jwe]
jwe
parents: 6746
diff changeset
39 ## The array is then reshaped internally to a matrix where the leading
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
40 ## dimension is given by
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
41 ## @tex
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
42 ## $$s_1 s_2 \cdots s_k$$
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
43 ## @end tex
8517
81d6ab3ac93c Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents: 7650
diff changeset
44 ## @ifnottex
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
45 ## @code{@var{s1} * @var{s2} * @dots{} * @var{sk}}
8517
81d6ab3ac93c Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents: 7650
diff changeset
46 ## @end ifnottex
9051
1bf0ce0930be Grammar check TexInfo in all .m files
Rik <rdrider0-list@yahoo.com>
parents: 8920
diff changeset
47 ## and each row in this matrix is then treated separately. Note that this
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
48 ## is exactly the opposite treatment than @code{interp1} and is done
7001
8b0cfeb06365 [project @ 2007-10-10 18:02:59 by jwe]
jwe
parents: 6746
diff changeset
49 ## for compatibility.
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
50 ##
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
51 ## Called with a third input argument, @code{pchip} evaluates the
9051
1bf0ce0930be Grammar check TexInfo in all .m files
Rik <rdrider0-list@yahoo.com>
parents: 8920
diff changeset
52 ## piece-wise polynomial at the points @var{xi}. There is an equivalence
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
53 ## between @code{ppval (pchip (@var{x}, @var{y}), @var{xi})} and
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
54 ## @code{pchip (@var{x}, @var{y}, @var{xi})}.
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
55 ##
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
56 ## @seealso{spline, ppval, mkpp, unmkpp}
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
57 ## @end deftypefn
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
58
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
59 ## Author: Kai Habel <kai.habel@gmx.de>
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
60 ## Date: 9. mar 2001
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
61 ##
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
62 ## S_k = a_k + b_k*x + c_k*x^2 + d_k*x^3; (spline polynom)
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
63 ##
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
64 ## 4 conditions:
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
65 ## S_k(x_k) = y_k;
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
66 ## S_k(x_k+1) = y_k+1;
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
67 ## S_k'(x_k) = y_k';
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
68 ## S_k'(x_k+1) = y_k+1';
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
69
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
70 function ret = pchip (x, y, xi)
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
71
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
72 if (nargin < 2 || nargin > 3)
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
73 print_usage ();
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
74 endif
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
75
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
76 x = x(:).';
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
77 n = length (x);
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
78
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
79 ## Check the size and shape of y
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
80 if (isvector (y))
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
81 y = y(:).';
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
82 szy = size (y);
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
83 else
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
84 szy = size (y);
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
85 y = reshape (y, [prod(szy(1:end-1)), szy(end)]);
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
86 endif
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
87
5838
376e02b2ce70 [project @ 2006-06-01 20:23:53 by jwe]
jwe
parents: 5837
diff changeset
88 h = diff (x);
376e02b2ce70 [project @ 2006-06-01 20:23:53 by jwe]
jwe
parents: 5837
diff changeset
89 if (all (h < 0))
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
90 x = fliplr (x);
5838
376e02b2ce70 [project @ 2006-06-01 20:23:53 by jwe]
jwe
parents: 5837
diff changeset
91 h = diff (x);
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
92 y = fliplr (y);
5838
376e02b2ce70 [project @ 2006-06-01 20:23:53 by jwe]
jwe
parents: 5837
diff changeset
93 elseif (any (h <= 0))
11472
1740012184f9 Use uppercase for variable names in error() strings to match Info documentation. Only m-files done.
Rik <octave@nomad.inbox5.com>
parents: 10793
diff changeset
94 error("pchip: X must be strictly monotonic");
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
95 endif
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
96
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
97 if (columns (y) != n)
11472
1740012184f9 Use uppercase for variable names in error() strings to match Info documentation. Only m-files done.
Rik <octave@nomad.inbox5.com>
parents: 10793
diff changeset
98 error("pchip: size of X and Y must match");
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
99 endif
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
100
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
101 f1 = y(:,1:n-1);
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
102
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
103 ## Compute derivatives.
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
104 d = __pchip_deriv__ (x, y, 2);
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
105 d1 = d(:,1:n-1);
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
106 d2 = d(:,2:n);
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
107
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
108 ## This is taken from SLATEC.
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
109 h = diag (h);
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
110
9754
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
111 delta = diff (y, 1, 2) / h;
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
112 del1 = (d1 - delta) / h;
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
113 del2 = (d2 - delta) / h;
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
114 c3 = del1 + del2;
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
115 c2 = -c3 - del1;
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
116 c3 = c3 / h;
4219e5cf773d improve interp1 and pchip
Jaroslav Hajek <highegg@gmail.com>
parents: 9211
diff changeset
117
9768
31900e17b5f5 improve Matlab compatibility & performance of ppval/mkpp and some associated funcs
Jaroslav Hajek <highegg@gmail.com>
parents: 9754
diff changeset
118 coeffs = cat (3, c3, c2, d1, f1);
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
119 pp = mkpp (x, coeffs, szy(1:end-1));
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
120
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
121 if (nargin == 2)
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
122 ret = pp;
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
123 else
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
124 ret = ppval (pp, xi);
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
125 endif
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
126
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
127 endfunction
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
128
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
129 %!demo
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
130 %! x = 0:8;
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
131 %! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0];
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
132 %! xi = 0:0.01:8;
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
133 %! yspline = spline(x,y,xi);
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
134 %! ypchip = pchip(x,y,xi);
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
135 %! title("pchip and spline fit to discontinuous function");
6746
a8105a726e68 [project @ 2007-06-19 08:18:34 by dbateman]
dbateman
parents: 6440
diff changeset
136 %! plot(xi,yspline,xi,ypchip,"-",x,y,"+");
a8105a726e68 [project @ 2007-06-19 08:18:34 by dbateman]
dbateman
parents: 6440
diff changeset
137 %! legend ("spline","pchip","data");
5837
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
138 %! %-------------------------------------------------------------------
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
139 %! % confirm that pchip agreed better to discontinuous data than spline
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
140
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
141 %!shared x,y
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
142 %! x = 0:8;
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
143 %! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0];
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
144 %!assert (pchip(x,y,x), y);
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
145 %!assert (pchip(x,y,x'), y');
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
146 %!assert (pchip(x',y',x'), y');
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
147 %!assert (pchip(x',y',x), y);
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
148 %!assert (isempty(pchip(x',y',[])));
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
149 %!assert (isempty(pchip(x,y,[])));
55404f3b0da1 [project @ 2006-06-01 19:05:31 by jwe]
jwe
parents:
diff changeset
150 %!assert (pchip(x,[y;y],x), [pchip(x,y,x);pchip(x,y,x)])