Mercurial > hg > octave-nkf
diff scripts/polynomial/pchip.m @ 5837:55404f3b0da1
[project @ 2006-06-01 19:05:31 by jwe]
author | jwe |
---|---|
date | Thu, 01 Jun 2006 19:05:32 +0000 |
parents | |
children | 376e02b2ce70 |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/scripts/polynomial/pchip.m @@ -0,0 +1,154 @@ +## Copyright (C) 2001,2002 Kai Habel +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{pp} = } pchip (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{yi} = } pchip (@var{x}, @var{y}, @var{xi}) +## +## Piecewise Cubic Hermite interpolating polynomial. Called with two +## arguments, the piece-wise polynomial @var{pp} is returned, that may +## later be used with @code{ppval} to evaluate the polynomial at +## specific points. +## +## The variable @var{x} must be a strictly monotonic vector (either +## increasing or decreasing). While @var{y} can be either a vector or +## array. In the case where @var{y} is a vector, it must have a length +## of @var{n}. If @var{y} is an array, then the size of @var{y} must +## have the form +## @iftex +## @tex +## $$[s_1, s_2, \cdots, s_k, n]$$ +## @end tex +## @end iftex +## @ifinfo +## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n}]} +## @end ifinfo +## The array is then reshaped internally to a matrix where to leading +## dimension is given by +## @iftex +## @tex +## $$s_1 s_2 \cdots s_k$$ +## @end tex +## @end iftex +## @ifinfo +## @code{@var{s1} * @var{s2} * @dots{} * @var{sk}} +## @end ifinfo +## and each row this matrix is then treated seperately. Note that this +## is exactly the opposite treatment than @code{interp1} and is done +## for compatiability. +## +## Called with a third input argument, @code{pchip} evaluates the +## piece-wise polynomial at the points @var{xi}. There is an equivalence +## between @code{ppval (pchip (@var{x}, @var{y}), @var{xi})} and +## @code{pchip (@var{x}, @var{y}, @var{xi})}. +## +## @seealso{spline, ppval, mkpp, unmkpp} +## @end deftypefn + +## Author: Kai Habel <kai.habel@gmx.de> +## Date: 9. mar 2001 +## +## S_k = a_k + b_k*x + c_k*x^2 + d_k*x^3; (spline polynom) +## +## 4 conditions: +## S_k(x_k) = y_k; +## S_k(x_k+1) = y_k+1; +## S_k'(x_k) = y_k'; +## S_k'(x_k+1) = y_k+1'; + +function ret = pchip (x, y, xi) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + x = x(:); + n = length (x); + + ## Check the size and shape of y + ndy = ndims (y); + szy = size (y); + if (ndy == 2 && (szy(1) == 1 || szy(2) == 1)) + if (szy(1) == 1) + y = y'; + else + szy = fliplr (szy); + endif + else + y = reshape (y, [prod(szy(1:end-1)), szy(end)])'; + endif + + h = diff(x); + if all(h<0) + x = flipud(x); + h = diff(x); + y = flipud(y); + elseif (any(h <= 0)) + error("pchip: x must be strictly monotonic") + endif + + if (rows(y) != n) + error("pchip: size of x and y must match"); + endif + + [ry, cy] = size (y); + if (cy > 1) + h = kron (diff (x), ones (1, cy)); + endif + + dy = diff (y) ./ h; + + a = y; + b = __pchip_deriv__(x,y); + c = - (b(2:n, :) + 2 * b(1:n - 1, :)) ./ h + 3 * diff (a) ./ h .^ 2; + d = (b(1:n - 1, :) + b(2:n, :)) ./ h.^2 - 2 * diff (a) ./ h.^3; + + d = d(1:n - 1, :); c = c(1:n - 1, :); + b = b(1:n - 1, :); a = a(1:n - 1, :); + coeffs = [d(:), c(:), b(:), a(:)]; + pp = mkpp (x, coeffs, szy(1:end-1)); + + if (nargin == 2) + ret = pp; + else + ret = ppval (pp, xi); + endif + +endfunction + +%!demo +%! x = 0:8; +%! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0]; +%! xi = 0:0.01:8; +%! yspline = spline(x,y,xi); +%! ypchip = pchip(x,y,xi); +%! title("pchip and spline fit to discontinuous function"); +%! plot(xi,yspline,";spline;",... +%! xi,ypchip,"-;pchip;",... +%! x,y,"+;data;"); +%! %------------------------------------------------------------------- +%! % confirm that pchip agreed better to discontinuous data than spline + +%!shared x,y +%! x = 0:8; +%! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0]; +%!assert (pchip(x,y,x), y); +%!assert (pchip(x,y,x'), y'); +%!assert (pchip(x',y',x'), y'); +%!assert (pchip(x',y',x), y); +%!assert (isempty(pchip(x',y',[]))); +%!assert (isempty(pchip(x,y,[]))); +%!assert (pchip(x,[y;y],x), [pchip(x,y,x);pchip(x,y,x)])