|
5824
|
1 ## Copyright (C) 2000,2001 Kai Habel |
|
|
2 ## Copyright (C) 2006 David Bateman |
|
|
3 ## |
|
|
4 ## This file is part of Octave. |
|
|
5 ## |
|
|
6 ## Octave is free software; you can redistribute it and/or modify it |
|
|
7 ## under the terms of the GNU General Public License as published by |
|
7016
|
8 ## the Free Software Foundation; either version 3 of the License, or (at |
|
|
9 ## your option) any later version. |
|
5824
|
10 ## |
|
|
11 ## Octave is distributed in the hope that it will be useful, but |
|
|
12 ## WITHOUT ANY WARRANTY; without even the implied warranty of |
|
|
13 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
|
14 ## General Public License for more details. |
|
|
15 ## |
|
|
16 ## You should have received a copy of the GNU General Public License |
|
7016
|
17 ## along with Octave; see the file COPYING. If not, see |
|
|
18 ## <http://www.gnu.org/licenses/>. |
|
5824
|
19 |
|
|
20 ## -*- texinfo -*- |
|
|
21 ## @deftypefn {Function File} {@var{pp} = } spline (@var{x}, @var{y}) |
|
|
22 ## @deftypefnx {Function File} {@var{yi} = } spline (@var{x}, @var{y}, @var{xi}) |
|
|
23 ## |
|
|
24 ## Returns the cubic spline interpolation of @var{y} at the point |
|
5837
|
25 ## @var{x}. Called with two arguments the piece-wise polynomial @var{pp} |
|
5824
|
26 ## that may later be used with @code{ppval} to evaluate the polynomial |
|
|
27 ## at specific points. |
|
|
28 ## |
|
|
29 ## The variable @var{x} must be a vector of length @var{n}, and @var{y} |
|
5837
|
30 ## can be either a vector or array. In the case where @var{y} is a |
|
5824
|
31 ## vector, it can have a length of either @var{n} or @code{@var{n} + 2}. |
|
|
32 ## If the length of @var{y} is @var{n}, then the 'not-a-knot' end |
|
|
33 ## condition is used. If the length of @var{y} is @code{@var{n} + 2}, |
|
|
34 ## then the first and last values of the vector @var{y} are the first |
|
|
35 ## derivative of the cubic spline at the end-points. |
|
|
36 ## |
|
|
37 ## If @var{y} is an array, then the size of @var{y} must have the form |
|
|
38 ## @iftex |
|
|
39 ## @tex |
|
|
40 ## $$[s_1, s_2, \cdots, s_k, n]$$ |
|
|
41 ## @end tex |
|
|
42 ## @end iftex |
|
|
43 ## @ifinfo |
|
|
44 ## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n}]} |
|
|
45 ## @end ifinfo |
|
|
46 ## or |
|
|
47 ## @iftex |
|
|
48 ## @tex |
|
|
49 ## $$[s_1, s_2, \cdots, s_k, n + 2]$$. |
|
|
50 ## @end tex |
|
|
51 ## @end iftex |
|
|
52 ## @ifinfo |
|
|
53 ## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n} + 2]}. |
|
|
54 ## @end ifinfo |
|
|
55 ## The array is then reshaped internally to a matrix where to leading |
|
|
56 ## dimension is given by |
|
|
57 ## @iftex |
|
|
58 ## @tex |
|
|
59 ## $$s_1 s_2 \cdots s_k$$ |
|
|
60 ## @end tex |
|
|
61 ## @end iftex |
|
|
62 ## @ifinfo |
|
|
63 ## @code{@var{s1} * @var{s2} * @dots{} * @var{sk}} |
|
|
64 ## @end ifinfo |
|
7001
|
65 ## and each row this matrix is then treated separately. Note that this |
|
5824
|
66 ## is exactly the opposite treatment than @code{interp1} and is done |
|
7001
|
67 ## for compatibility. |
|
5824
|
68 ## |
|
|
69 ## Called with a third input argument, @code{spline} evaluates the |
|
|
70 ## piece-wise spline at the points @var{xi}. There is an equivalence |
|
|
71 ## between @code{ppval (spline (@var{x}, @var{y}), @var{xi})} and |
|
|
72 ## @code{spline (@var{x}, @var{y}, @var{xi})}. |
|
|
73 ## |
|
|
74 ## @seealso{ppval, mkpp, unmkpp} |
|
|
75 ## @end deftypefn |
|
|
76 |
|
|
77 ## This code is based on csape.m from octave-forge, but has been |
|
|
78 ## modified to use the sparse solver code in octave that itself allows |
|
|
79 ## special casing of tri-diagonal matrices, modified for NDArrays and |
|
|
80 ## for the treatment of vectors y 2 elements longer than x as complete |
|
|
81 ## splines. |
|
|
82 |
|
|
83 function ret = spline (x, y, xi) |
|
|
84 |
|
|
85 x = x(:); |
|
|
86 n = length (x); |
|
|
87 if (n < 3) |
|
|
88 error ("spline: requires at least 3 points"); |
|
|
89 endif |
|
|
90 |
|
|
91 ## Check the size and shape of y |
|
|
92 ndy = ndims (y); |
|
|
93 szy = size (y); |
|
|
94 if (ndy == 2 && (szy(1) == 1 || szy(2) == 1)) |
|
|
95 if (szy(1) == 1) |
|
6014
|
96 a = y.'; |
|
5824
|
97 else |
|
|
98 a = y; |
|
|
99 szy = fliplr (szy); |
|
|
100 endif |
|
|
101 else |
|
6014
|
102 a = reshape (y, [prod(szy(1:end-1)), szy(end)]).'; |
|
5824
|
103 endif |
|
|
104 complete = false; |
|
|
105 if (size (a, 1) == n + 2) |
|
|
106 complete = true; |
|
|
107 dfs = a(1,:); |
|
|
108 dfe = a(end,:); |
|
|
109 a = a(2:end-1,:); |
|
|
110 endif |
|
|
111 |
|
|
112 b = c = zeros (size (a)); |
|
|
113 h = diff (x); |
|
5838
|
114 idx = ones (columns (a), 1); |
|
5824
|
115 |
|
|
116 if (complete) |
|
|
117 |
|
|
118 if (n == 3) |
|
|
119 dg = 1.5 * h(1) - 0.5 * h(2); |
|
5838
|
120 c(2:n-1,:) = 1/dg(1); |
|
5824
|
121 else |
|
5838
|
122 dg = 2 * (h(1:n-2) .+ h(2:n-1)); |
|
5824
|
123 dg(1) = dg(1) - 0.5 * h(1); |
|
5838
|
124 dg(n-2) = dg(n-2) - 0.5 * h(n-1); |
|
5824
|
125 |
|
5838
|
126 e = h(2:n-2); |
|
5824
|
127 |
|
|
128 size(a) |
|
|
129 size(h) |
|
|
130 n |
|
|
131 |
|
5838
|
132 g = 3 * diff (a(2:n,:)) ./ h(2:n-1,idx) ... |
|
|
133 - 3 * diff (a(1:n-1,:)) ./ h(1:n-2,idx); |
|
|
134 g(1,:) = 3 * (a(3,:) - a(2,:)) / h(2) ... |
|
5824
|
135 - 3 / 2 * (3 * (a(2,:) - a(1,:)) / h(1) - dfs); |
|
5838
|
136 g(n-2,:) = 3 / 2 * (3 * (a(n,:) - a(n-1,:)) / h(n-1) - dfe) ... |
|
|
137 - 3 * (a(n-1,:) - a(n-2,:)) / h(n-2); |
|
5824
|
138 |
|
5838
|
139 c(2:n-1,:) = spdiags ([[e(:); 0], dg, [0; e(:)]], |
|
|
140 [-1, 0, 1], n-2, n-2) \ g; |
|
5824
|
141 endif |
|
|
142 |
|
|
143 c(1,:) = (3 / h(1) * (a(2,:) - a(1,:)) - 3 * dfs |
|
5838
|
144 - c(2,:) * h(1)) / (2 * h(1)); |
|
|
145 c(n,:) = - (3 / h(n-1) * (a(n,:) - a(n-1,:)) - 3 * dfe |
|
|
146 + c(n-1,:) * h(n-1)) / (2 * h(n-1)); |
|
|
147 b(1:n-1,:) = diff (a) ./ h(1:n-1, idx) ... |
|
|
148 - h(1:n-1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:)); |
|
|
149 d = diff (c) ./ (3 * h(1:n-1, idx)); |
|
5824
|
150 |
|
|
151 else |
|
|
152 |
|
5838
|
153 g = zeros (n-2, columns (a)); |
|
|
154 g(1,:) = 3 / (h(1) + h(2)) ... |
|
|
155 * (a(3,:) - a(2,:) - h(2) / h(1) * (a(2,:) - a(1,:))); |
|
|
156 g(n-2,:) = 3 / (h(n-1) + h(n-2)) ... |
|
|
157 * (h(n-2) / h(n-1) * (a(n,:) - a(n-1,:)) - (a(n-1,:) - a(n-2,:))); |
|
5824
|
158 |
|
|
159 if (n > 4) |
|
|
160 |
|
5838
|
161 g(2:n - 3,:) = 3 * diff (a(3:n-1,:)) ./ h(3:n-2,idx) ... |
|
|
162 - 3 * diff (a(2:n-2,:)) ./ h(2:n - 3,idx); |
|
5824
|
163 |
|
5838
|
164 dg = 2 * (h(1:n-2) .+ h(2:n-1)); |
|
5824
|
165 dg(1) = dg(1) - h(1); |
|
5838
|
166 dg(n-2) = dg(n-2) - h(n-1); |
|
5824
|
167 |
|
5838
|
168 ldg = udg = h(2:n-2); |
|
5824
|
169 udg(1) = udg(1) - h(1); |
|
5838
|
170 ldg(n - 3) = ldg(n-3) - h(n-1); |
|
|
171 c(2:n-1,:) = spdiags ([[ldg(:); 0], dg, [0; udg(:)]], |
|
|
172 [-1, 0, 1], n-2, n-2) \ g; |
|
5824
|
173 |
|
|
174 elseif (n == 4) |
|
|
175 |
|
6248
|
176 dg = [h(1) + 2 * h(2); 2 * h(2) + h(3)]; |
|
5824
|
177 ldg = h(2) - h(3); |
|
|
178 udg = h(2) - h(1); |
|
5838
|
179 c(2:n-1,:) = spdiags ([[ldg(:);0], dg, [0; udg(:)]], |
|
|
180 [-1, 0, 1], n-2, n-2) \ g; |
|
5824
|
181 |
|
|
182 else # n == 3 |
|
|
183 |
|
5838
|
184 dg = h(1) + 2 * h(2); |
|
|
185 c(2:n-1,:) = g/dg(1); |
|
5824
|
186 |
|
|
187 endif |
|
|
188 |
|
|
189 c(1,:) = c(2,:) + h(1) / h(2) * (c(2,:) - c(3,:)); |
|
5838
|
190 c(n,:) = c(n-1,:) + h(n-1) / h(n-2) * (c(n-1,:) - c(n-2,:)); |
|
|
191 b = diff (a) ./ h(1:n-1, idx) ... |
|
|
192 - h(1:n-1, idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:)); |
|
|
193 d = diff (c) ./ (3 * h(1:n-1, idx)); |
|
5824
|
194 |
|
|
195 endif |
|
|
196 |
|
5838
|
197 d = d(1:n-1,:); |
|
|
198 c = c(1:n-1,:); |
|
|
199 b = b(1:n-1,:); |
|
|
200 a = a(1:n-1,:); |
|
5824
|
201 coeffs = [d(:), c(:), b(:), a(:)]; |
|
|
202 ret = mkpp (x, coeffs, szy(1:end-1)); |
|
|
203 |
|
|
204 if (nargin == 3) |
|
|
205 ret = ppval (ret, xi); |
|
|
206 endif |
|
|
207 |
|
|
208 endfunction |
|
|
209 |
|
|
210 %!demo |
|
|
211 %! x = 0:10; y = sin(x); |
|
|
212 %! xspline = 0:0.1:10; yspline = spline(x,y,xspline); |
|
|
213 %! title("spline fit to points from sin(x)"); |
|
6702
|
214 %! plot(xspline,sin(xspline),"r",xspline,yspline,"g-",x,y,"b+"); |
|
|
215 %! legend("original","interpolation","interpolation points"); |
|
5824
|
216 %! %-------------------------------------------------------- |
|
|
217 %! % confirm that interpolated function matches the original |
|
|
218 |
|
6686
|
219 %!shared x,y,abserr |
|
|
220 %! x = [0:10]; y = sin(x); abserr = 1e-14; |
|
|
221 %!assert (spline(x,y,x), y, abserr); |
|
|
222 %!assert (spline(x,y,x'), y', abserr); |
|
|
223 %!assert (spline(x',y',x'), y', abserr); |
|
|
224 %!assert (spline(x',y',x), y, abserr); |
|
5824
|
225 %!assert (isempty(spline(x',y',[]))); |
|
|
226 %!assert (isempty(spline(x,y,[]))); |
|
6686
|
227 %!assert (spline(x,[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr) |
|
6014
|
228 %! y = cos(x) + i*sin(x); |
|
6686
|
229 %!assert (spline(x,y,x), y, abserr) |
|
|
230 %!assert (real(spline(x,y,x)), real(y), abserr); |
|
|
231 %!assert (real(spline(x,y,x.')), real(y).', abserr); |
|
|
232 %!assert (real(spline(x.',y.',x.')), real(y).', abserr); |
|
|
233 %!assert (real(spline(x.',y,x)), real(y), abserr); |
|
|
234 %!assert (imag(spline(x,y,x)), imag(y), abserr); |
|
|
235 %!assert (imag(spline(x,y,x.')), imag(y).', abserr); |
|
|
236 %!assert (imag(spline(x.',y.',x.')), imag(y).', abserr); |
|
|
237 %!assert (imag(spline(x.',y,x)), imag(y), abserr); |
