|
0
|
1 ## Copyright (C) 2001 Kai Habel |
|
|
2 ## |
|
|
3 ## This program is free software; you can redistribute it and/or modify |
|
|
4 ## it under the terms of the GNU General Public License as published by |
|
|
5 ## the Free Software Foundation; either version 2 of the License, or |
|
|
6 ## (at your option) any later version. |
|
|
7 ## |
|
|
8 ## This program is distributed in the hope that it will be useful, |
|
|
9 ## but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
|
10 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
|
11 ## GNU General Public License for more details. |
|
|
12 ## |
|
|
13 ## You should have received a copy of the GNU General Public License |
|
|
14 ## along with this program; if not, write to the Free Software |
|
|
15 ## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
|
16 |
|
|
17 ## -*- texinfo -*- |
|
|
18 ## @deftypefn {Function File} {@var{pp} = } pchip (@var{x}, @var{y}) |
|
|
19 ## @deftypefnx {Function File} {@var{yi} = } pchip (@var{x}, @var{y}, @var{xi}) |
|
|
20 ## piecewise cubic hermite interpolating polynom. |
|
|
21 ## pchip preserves the monotonicity of (x,y) |
|
|
22 ## |
|
|
23 ## @seealso{ppval, spline, csape} |
|
|
24 ## @end deftypefn |
|
|
25 |
|
|
26 ## Author: Kai Habel <kai.habel@gmx.de> |
|
|
27 ## Date: 9. mar 2001 |
|
|
28 ## 2001-04-03 Paul Kienzle |
|
|
29 ## * move (:) from definition of l,r to use of l,r so it works with 2.0 |
|
|
30 |
|
|
31 ## S_k = a_k + b_k*x + c_k*x^2 + d_k*x^3; (spline polynom) |
|
|
32 ## |
|
|
33 ## 4 conditions: |
|
|
34 ## S_k(x_k) = y_k; |
|
|
35 ## S_k(x_k+1) = y_k+1; |
|
|
36 ## S_k'(x_k) = y_k'; |
|
|
37 ## S_k'(x_k+1) = y_k+1'; |
|
|
38 ## |
|
|
39 ## 22. april 2001: Hmm, something is wrong, it seems pchip doesn't |
|
|
40 ## preserve the monotonicity, as expected. So if _you_ know how to |
|
|
41 ## do it right, please contact me. Kai |
|
|
42 |
|
|
43 function ret = pchip (x, y, xi) |
|
|
44 |
|
|
45 if (nargin < 2 || nargin > 3) |
|
|
46 usage ("pchip (x, y, [xi])"); |
|
|
47 endif |
|
|
48 |
|
|
49 x = x(:); |
|
|
50 n = length (x); |
|
|
51 |
|
|
52 if (columns(y) == n) y = y'; endif |
|
|
53 |
|
|
54 [ry,cy] = size (y); |
|
|
55 if (cy > 1) |
|
|
56 h = kron (diff (x), ones (1, cy)); |
|
|
57 else |
|
|
58 h = diff (x); |
|
|
59 endif |
|
|
60 |
|
|
61 a = y; |
|
|
62 |
|
|
63 dy = diff (y) ./ h; |
|
|
64 t = diff (sign (dy)) == 0; |
|
|
65 l = dy(1:n - 2, :); |
|
|
66 r = dy(2:n - 1, :); |
|
|
67 b = zeros (size (y)); |
|
|
68 s = reshape (0.5 * (l(:) + r(:)), ry - 2, cy); |
|
|
69 b(2:ry - 1,:) = s .* t; |
|
|
70 |
|
|
71 c = - (b(2:n, :) + 2 * b(1:n - 1, :)) ./ h + 3 * diff (a) ./ h .^ 2; |
|
|
72 |
|
|
73 d = (b(1:n - 1, :) + b(2:n, :)) ./ h.^2 - 2 * diff (a) ./ h.^3; |
|
|
74 |
|
|
75 d = d(1:n - 1, :); c = c(1:n - 1, :); |
|
|
76 b = b(1:n - 1, :); a = a(1:n - 1, :); |
|
|
77 |
|
|
78 coeffs = [d(:), c(:), b(:), a(:)]; |
|
|
79 pp = mkpp (x, coeffs); |
|
|
80 |
|
|
81 if (nargin == 2) |
|
|
82 ret = pp; |
|
|
83 else |
|
|
84 ret = ppval(pp,xi); |
|
|
85 endif |
|
|
86 |
|
|
87 endfunction |
