changeset 12608:59e2460acae1

make piecewise polynomial (pp) functions more compatible
author Kai Habel <kai.habel@gmx.de>
date Wed, 23 Feb 2011 08:11:40 +0100
parents 3047363c376d
children f3ba948328e9
files scripts/ChangeLog scripts/general/interp1.m scripts/polynomial/mkpp.m scripts/polynomial/pchip.m scripts/polynomial/ppder.m scripts/polynomial/ppint.m scripts/polynomial/ppjumps.m scripts/polynomial/ppval.m scripts/polynomial/spline.m scripts/polynomial/unmkpp.m
diffstat 10 files changed, 352 insertions(+), 269 deletions(-) [+]
line wrap: on
line diff
--- a/scripts/ChangeLog	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/ChangeLog	Wed Feb 23 08:11:40 2011 +0100
@@ -1,3 +1,12 @@
+2011-04-15  Kai Habel  <kai.habel@gmx.de>
+
+	* general/interp1.m, polynomial/mkpp.m, polynomial/pchip.m,
+	polynomial/ppder.m, polynomial/ppint.m, polynomial/ppjumps.m,
+	polynomial/ppval.m, polynomial/spline.m, polynomial/unmkpp.m:
+	Make functions more compatible with respect to handling of
+	picewise polynoms (pp). Rename pp-struct elements.
+	Handle nD-arguments correctly. Tests added.
+
 2011-04-13  Rik  <octave@nomad.inbox5.com>
 
 	* help/__makeinfo__.m: Simplify function by using regular expressions.
@@ -414,11 +423,6 @@
 
 	* statistics/base/mean.m: Also accept logical values.
 
-2011-02-10 Carlo de Falco  <kingcrimson@tiscali.it>
-
-	* linear-algebra/gmres.m: New file implementing the GMRES
-	iterative method for solving linear systems.
-
 2011-02-08  Ben Abbott  <bpabbott@mac.com>
 
 	* plot/__go_draw_axes__.m: Properly set fontspec for legends.
--- a/scripts/general/interp1.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/general/interp1.m	Wed Feb 23 08:11:40 2011 +0100
@@ -43,7 +43,7 @@
 ## Piecewise cubic Hermite interpolating polynomial
 ##
 ## @item 'cubic'
-## Cubic interpolation from four nearest neighbors
+## Cubic interpolation (same as @code{pchip})
 ##
 ## @item 'spline'
 ## Cubic spline interpolation---smooth first and second derivatives
@@ -112,7 +112,7 @@
   method = "linear";
   extrap = NA;
   xi = [];
-  pp = false;
+  ispp = false;
   firstnumeric = true;
 
   if (nargin > 2)
@@ -123,7 +123,7 @@
         if (strcmp ("extrap", arg))
           extrap = "extrap";
         elseif (strcmp ("pp", arg))
-          pp = true;
+          ispp = true;
         else
           method = arg;
         endif
@@ -138,7 +138,7 @@
     endfor
   endif
 
-  if (isempty (xi) && firstnumeric && ! pp)
+  if (isempty (xi) && firstnumeric && ! ispp)
     xi = y;
     y = x;
     x = 1:numel(y);
@@ -150,9 +150,8 @@
   szx = size (xi);
   if (isvector (y))
     y = y(:);
-  elseif (isvector (xi))
-    szx = length (xi);
   endif
+  
   szy = size (y);
   y = y(:,:);
   [ny, nc] = size (y);
@@ -191,147 +190,85 @@
 
   switch (method)
   case "nearest"
-    if (pp)
-      yi = mkpp ([x(1); (x(1:nx-1)+x(2:nx))/2; x(nx)], y, szy(2:end));
+    pp = mkpp ([x(1); (x(1:nx-1)+x(2:nx))/2; x(nx)], shiftdim (y, 1), szy(2:end));
+    pp.orient = "first";
+    
+    if (ispp)
+      yi = pp;
     else
-      idx = lookup (0.5*(x(1:nx-1)+x(2:nx)), xi) + 1;
-      yi = y(idx,:);
+      yi = ppval (pp, reshape (xi, szx));
     endif
   case "*nearest"
-    if (pp)
-      yi = mkpp ([x(1); x(1)+[0.5:(nx-1)]'*dx; x(nx)], y, szy(2:end));
+    pp = mkpp ([x(1), x(1)+[0.5:(nx-1)]*dx, x(nx)], shiftdim (y, 1), szy(2:end));
+    pp.orient = "first";
+    if (ispp)
+      yi = pp;
     else
-      idx = max (1, min (ny, floor((xi-x(1))/dx+1.5)));
-      yi = y(idx,:);
+      yi = ppval(pp, reshape (xi, szx));
     endif
   case "linear"
     dy = diff (y);
-    dx = diff (x);
-    if (pp)
-      coefs = [dy./dx, y(1:nx-1)];
-      xx = x;
-      if (have_jumps)
-        ## Omit zero-size intervals.
-        coefs(jumps) = [];
-        xx(jumps) = [];
-      endif
-      yi = mkpp (xx, coefs, szy(2:end));
+    dx = diff (x);    
+    dx = repmat (dx, [1 size(dy)(2:end)]);
+    coefs = [(dy./dx).'(:), y(1:nx-1, :).'(:)];
+    xx = x;
+
+    if (have_jumps)
+      ## Omit zero-size intervals.
+      coefs(jumps, :) = [];
+      xx(jumps) = [];
+    endif
+
+    pp = mkpp (xx, coefs, szy(2:end));
+    pp.orient = "first";
+
+    if (ispp)
+      yi = pp;
     else
-      ## find the interval containing the test point
-      idx = lookup (x, xi, "lr");
-      ## use the endpoints of the interval to define a line
-      s = (xi - x(idx))./dx(idx);
-      yi = bsxfun (@times, s, dy(idx,:)) + y(idx,:);
-      if (have_jumps)
-        ## Fix the corner cases of discontinuities at boundaries.
-        ## Internal discontinuities already handled correctly.
-        if (jumps (1))
-          mask = xi < x(1);
-          yi(mask,:) = y(1*ones (1, sum (mask)),:);
-        endif
-        if (jumps(nx-1))
-          mask = xi >= x(nx);
-          yi(mask,:) = y(nx*ones (1, sum (mask)),:);
-        endif
-      endif
+      yi = ppval(pp, reshape (xi, szx));
     endif
+
   case "*linear"
     dy = diff (y);
-    if (pp)
-      yi = mkpp (x(1) + [0:ny-1]*dx, [dy./dx, y(1:end-1)], szy(2:end));
+    coefs = [(dy/dx).'(:), y(1:nx-1, :).'(:)];
+    pp = mkpp (x, coefs, szy(2:end));
+    pp.orient = "first";
+
+    if (ispp)
+      yi = pp;
     else
-      ## find the interval containing the test point
-      t = (xi - x(1))/dx + 1;
-      idx = max (1, min (ny - 1, floor (t)));
+      yi = ppval(pp, reshape (xi, szx));
+    endif
 
-      ## use the endpoints of the interval to define a line
-      s = t - idx;
-      yi = bsxfun (@times, s, dy(idx,:)) + y(idx,:);
-    endif
-  case {"pchip", "*pchip"}
+  case {"pchip", "*pchip", "cubic", "*cubic"}
     if (nx == 2 || starmethod)
       x = linspace (x(1), x(nx), ny);
     endif
-    ## Note that pchip's arguments are transposed relative to interp1
-    if (pp)
-      yi = pchip (x.', y.');
-      yi.d = szy(2:end);
-    else
-      yi = pchip (x.', y.', xi.').';
-    endif
-
-  case {"cubic", "*cubic"}
-    if (nx < 4 || ny < 4)
-      error ("interp1: table too short");
-    endif
-
-    ## FIXME Is there a better way to treat pp return and *cubic
-    if (starmethod && ! pp)
-      ## From: Miloje Makivic
-      ## http://www.npac.syr.edu/projects/nasa/MILOJE/final/node36.html
-      t = (xi - x(1))/dx + 1;
-      idx = max (min (floor (t), ny-2), 2);
-      t = t - idx;
-      t2 = t.*t;
-      tp = 1 - 0.5*t;
-      a = (1 - t2).*tp;
-      b = (t2 + t).*tp;
-      c = (t2 - t).*tp/3;
-      d = (t2 - 1).*t/6;
-      J = ones (1, nc);
-
-      yi = a(:,J) .* y(idx,:) + b(:,J) .* y(idx+1,:) ...
-      + c(:,J) .* y(idx-1,:) + d(:,J) .* y(idx+2,:);
+    
+    if (ispp)
+      y = shiftdim (reshape (y, szy), 1);
+      yi = pchip (x, y);
     else
-      if (starmethod)
-        x = linspace (x(1), x(nx), ny).';
-        nx = ny;
-      endif
-
-      idx = lookup (x(2:nx-1), xi, "lr");
-
-      ## Construct cubic equations for each interval using divided
-      ## differences (computation of c and d don't use divided differences
-      ## but instead solve 2 equations for 2 unknowns). Perhaps
-      ## reformulating this as a lagrange polynomial would be more efficient.
-      i = 1:nx-3;
-      J = ones (1, nc);
-      dx = diff (x);
-      dx2 = x(i+1).^2 - x(i).^2;
-      dx3 = x(i+1).^3 - x(i).^3;
-      a = diff (y, 3)./dx(i,J).^3/6;
-      b = (diff (y(1:nx-1,:), 2)./dx(i,J).^2 - 6*a.*x(i+1,J))/2;
-      c = (diff (y(1:nx-2,:), 1) - a.*dx3(:,J) - b.*dx2(:,J))./dx(i,J);
-      d = y(i,:) - ((a.*x(i,J) + b).*x(i,J) + c).*x(i,J);
-
-      if (pp)
-        xs = [x(1);x(3:nx-2)];
-        yi = mkpp ([x(1);x(3:nx-2);x(nx)],
-                   [a(:), (b(:) + 3.*xs(:,J).*a(:)), ...
-                    (c(:) + 2.*xs(:,J).*b(:) + 3.*xs(:,J)(:).^2.*a(:)), ...
-                    (d(:) + xs(:,J).*c(:) + xs(:,J).^2.*b(:) + ...
-                     xs(:,J).^3.*a(:))], szy(2:end));
-      else
-        yi = ((a(idx,:).*xi(:,J) + b(idx,:)).*xi(:,J) ...
-              + c(idx,:)).*xi(:,J) + d(idx,:);
-      endif
+      y = shiftdim (y, 1);
+      yi = pchip (x, y, reshape (xi, szx));
     endif
   case {"spline", "*spline"}
     if (nx == 2 || starmethod)
       x = linspace(x(1), x(nx), ny);
     endif
-    ## Note that spline's arguments are transposed relative to interp1
-    if (pp)
-      yi = spline (x.', y.');
-      yi.d = szy(2:end);
+    
+    if (ispp)
+      y = shiftdim (reshape (y, szy), 1);
+      yi = spline (x, y);
     else
-      yi = spline (x.', y.', xi.').';
+      y = shiftdim (y, 1);
+      yi = spline (x, y, reshape (xi, szx));
     endif
   otherwise
     error ("interp1: invalid method '%s'", method);
   endswitch
 
-  if (! pp)
+  if (! ispp)
     if (! ischar (extrap))
       ## determine which values are out of range and set them to extrap,
       ## unless extrap == "extrap".
@@ -339,10 +276,24 @@
       maxx = max (x(1), x(nx));
 
       outliers = xi < minx | ! (xi <= maxx); # this catches even NaNs
-      yi(outliers, :) = extrap;
+      if (size_equal (outliers, yi))
+        yi(outliers) = extrap;
+        yi = reshape (yi, szx);
+      elseif (!isvector (yi))
+        if (strcmp (method, "pchip") || strcmp (method, "*pchip")
+          ||strcmp (method, "cubic") || strcmp (method, "*cubic")
+          ||strcmp (method, "spline") || strcmp (method, "*spline"))
+          yi(:, outliers) = extrap;
+          yi = shiftdim(yi, 1);
+        else
+          yi(outliers, :) = extrap;
+        endif
+      else
+        yi(outliers.') = extrap;
+      endif
     endif
-
-    yi = reshape (yi, [szx, szy(2:end)]);
+  else
+    yi.orient = "first";
   endif
 
 endfunction
@@ -394,6 +345,7 @@
 %! %--------------------------------------------------------
 %! % confirm that interpolated function matches the original
 
+##FIXME: add test for n-d arguments here
 
 ## For each type of interpolated test, confirm that the interpolated
 ## value at the knots match the values at the knots.  Points away
@@ -595,7 +547,6 @@
 %!assert (interp1(1:2,1:2,1.4,"nearest"),1);
 %!error interp1(1,1,1, "linear");
 %!assert (interp1(1:2,1:2,1.4,"linear"),1.4);
-%!error interp1(1:3,1:3,1, "cubic");
 %!assert (interp1(1:4,1:4,1.4,"cubic"),1.4);
 %!assert (interp1(1:2,1:2,1.1, "spline"), 1.1);
 %!assert (interp1(1:3,1:3,1.4,"spline"),1.4);
@@ -604,7 +555,6 @@
 %!assert (interp1(1:2:4,1:2:4,1.4,"*nearest"),1);
 %!error interp1(1,1,1, "*linear");
 %!assert (interp1(1:2:4,1:2:4,[0,1,1.4,3,4],"*linear"),[NA,1,1.4,3,NA]);
-%!error interp1(1:3,1:3,1, "*cubic");
 %!assert (interp1(1:2:8,1:2:8,1.4,"*cubic"),1.4);
 %!assert (interp1(1:2,1:2,1.3, "*spline"), 1.3);
 %!assert (interp1(1:2:6,1:2:6,1.4,"*spline"),1.4);
@@ -612,5 +562,5 @@
 %!assert (interp1([3,2,1],[3,2,2],2.5),2.5)
 
 %!assert (interp1 ([1,2,2,3,4],[0,1,4,2,1],[-1,1.5,2,2.5,3.5], "linear", "extrap"), [-2,0.5,4,3,1.5])
-%!assert (interp1 ([4,4,3,2,0],[0,1,4,2,1],[1.5,4,4.5], "linear"), [0,1,NA])
+%!assert (interp1 ([4,4,3,2,0],[0,1,4,2,1],[1.5,4,4.5], "linear"), [1.75,1,NA])
 %!assert (interp1 (0:4, 2.5), 1.5)
--- a/scripts/polynomial/mkpp.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/polynomial/mkpp.m	Wed Feb 23 08:11:40 2011 +0100
@@ -17,50 +17,66 @@
 ## <http://www.gnu.org/licenses/>.
 
 ## -*- texinfo -*-
-## @deftypefn  {Function File} {@var{pp} =} mkpp (@var{x}, @var{p})
-## @deftypefnx {Function File} {@var{pp} =} mkpp (@var{x}, @var{p}, @var{d})
+## @deftypefn  {Function File} {@var{pp} =} mkpp (@var{breaks}, @var{coefs})
+## @deftypefnx {Function File} {@var{pp} =} mkpp (@var{breaks}, @var{coefs}, @var{d})
+##
+## Construct a piece-wise polynomial (pp) structure from sample points
+## @var{breaks} and coefficients @var{coefs}.  @var{breaks} must be a vector of
+## strictly increasing values. The number of intervals is given by 
+## @code{@var{ni} = length (@var{breaks}) - 1}.
+## When @var{m} is the polynomial order @var{coefs} must be of 
+## size: @var{ni} x @var{m} + 1.
 ##
-## Construct a piecewise polynomial structure from sample points
-## @var{x} and coefficients @var{p}.  The i-th row of @var{p},
-## @code{@var{p} (@var{i},:)}, contains the coefficients for the polynomial
-## over the @var{i}-th interval, ordered from highest to
-## lowest.  There must be one row for each interval in @var{x}, so
-## @code{rows (@var{p}) == length (@var{x}) - 1}.
+## The i-th row of @var{coefs},
+## @code{@var{coefs} (@var{i},:)}, contains the coefficients for the polynomial
+## over the @var{i}-th interval, ordered from highest (@var{m}) to 
+## lowest (@var{0}).
 ##
-## @var{p} may also be a multi-dimensional array, specifying a vector-valued
-## or array-valued polynomial.  The shape is determined by @var{d}.  If @var{d}
-## is
-## not given, the default is @code{size (p)(1:end-2)}.  If @var{d} is given, the
-## leading dimensions of @var{p} are reshaped to conform to @var{d}.
+## @var{coefs} may also be a multi-dimensional array, specifying a vector-valued
+## or array-valued polynomial. In that case the polynomial order is defined
+## by the length of the last dimension of @var{coefs}.
+## The size of first dimension(s) are given by the scalar or
+## vector @var{d}. If @var{d} is not given it is set to @code{1}. 
+## In any case @var{coefs} is reshaped to a 2d matrix of
+## size @code{[@var{ni}*prod(@var{d} @var{m})] }
 ##
 ## @seealso{unmkpp, ppval, spline}
 ## @end deftypefn
 
 function pp = mkpp (x, P, d)
+
+  # check number of arguments
   if (nargin < 2 || nargin > 3)
     print_usage ();
   endif
-  pp.x = x(:);
-  n = length (x) - 1;
-  if (n < 1)
+
+  # check x
+  if (length (x) < 2)
     error ("mkpp: at least one interval is needed");
   endif
-  nd = ndims (P);
-  k = size (P, nd);
-  if (nargin < 3)
-    if (nd == 2)
-      d = 1;
-    else
-      d = prod (size (P)(1:nd-1));
-    endif
+
+  if (!isvector (x))
+    error ("mkpp: x must be a vector");
   endif
-  pp.d = d;
-  pp.P = P = reshape (P, prod (d), [], k);
-  pp.orient = 0;
+
+  len = length (x) - 1;
+  dP = length (size (P));
 
-  if (size (P, 2) != n)
-    error ("mkpp: num intervals in X doesn't match num polynomials in P");
-  endif
+  pp = struct ("form", "pp",
+               "breaks", x(:).',
+               "coefs", [],
+               "pieces", len,
+               "order", prod (size (P)) / len,
+               "dim", 1);
+
+  if (nargin == 3)
+    pp.dim = d;
+    pp.order /= prod (d);
+  endif 
+
+  dim_vec = [pp.pieces * prod(pp.dim), pp.order];
+  pp.coefs = reshape (P, dim_vec);
+
 endfunction
 
 %!demo # linear interpolation
@@ -72,3 +88,25 @@
 %! xi=linspace(0,pi,50);
 %! plot(x,t,"x",xi,ppval(pp,xi));
 %! legend("control","interp");
+
+%!shared b,c,pp
+%! b = 1:3; c = 1:24; pp=mkpp(b,c);
+%!assert (pp.pieces,2);
+%!assert (pp.order,12);
+%!assert (pp.dim,1);
+%!assert (size(pp.coefs),[2,12]);
+%! pp=mkpp(b,c,2);
+%!assert (pp.pieces,2);
+%!assert (pp.order,6);
+%!assert (pp.dim,2);
+%!assert (size(pp.coefs),[4,6]);
+%! pp=mkpp(b,c,3);
+%!assert (pp.pieces,2);
+%!assert (pp.order,4);
+%!assert (pp.dim,3);
+%!assert (size(pp.coefs),[6,4]);
+%! pp=mkpp(b,c,[2,3]);
+%!assert (pp.pieces,2);
+%!assert (pp.order,2);
+%!assert (pp.dim,[2,3]);
+%!assert (size(pp.coefs),[12,2]);
--- a/scripts/polynomial/pchip.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/polynomial/pchip.m	Wed Feb 23 08:11:40 2011 +0100
@@ -27,8 +27,8 @@
 ##
 ## 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
+## an array.  In the case where @var{y} is a vector, it must have the
+## length @var{n}.  If @var{y} is an array, then the size of @var{y} must
 ## have the form
 ## @tex
 ## $$[s_1, s_2, \cdots, s_k, n]$$
@@ -73,15 +73,22 @@
     print_usage ();
   endif
 
+  ## make row vector
   x = x(:).';
   n = length (x);
 
   ## Check the size and shape of y
   if (isvector (y))
-    y = y(:).';
+    y = y(:).'; ##row vector
     szy = size (y);
+    if !(size_equal (x, y))
+      error ("pchip: length of X and Y must match")
+    endif
   else
     szy = size (y);
+    if (n != szy(end))
+      error ("pchip: length of X and last dimension of Y must match")
+    endif
     y = reshape (y, [prod(szy(1:end-1)), szy(end)]);
   endif
 
@@ -94,16 +101,12 @@
     error("pchip: X must be strictly monotonic");
   endif
 
-  if (columns (y) != n)
-    error("pchip: size of X and Y must match");
-  endif
-
-  f1 = y(:,1:n-1);
+  f1 = y(:, 1:n-1);
 
   ## Compute derivatives.
   d = __pchip_deriv__ (x, y, 2);
-  d1 = d(:,1:n-1);
-  d2 = d(:,2:n);
+  d1 = d(:, 1:n-1);
+  d2 = d(:, 2:n);
 
   ## This is taken from SLATEC.
   h = diag (h);
@@ -114,14 +117,12 @@
   c3 = del1 + del2;
   c2 = -c3 - del1;
   c3 = c3 / h;
-
   coeffs = cat (3, c3, c2, d1, f1);
-  pp = mkpp (x, coeffs, szy(1:end-1));
 
-  if (nargin == 2)
-    ret = pp;
-  else
-    ret = ppval (pp, xi);
+  ret = mkpp (x, coeffs, szy(1:end-1));
+
+  if (nargin == 3)
+    ret = ppval (ret, xi);
   endif
 
 endfunction
@@ -138,7 +139,7 @@
 %! %-------------------------------------------------------------------
 %! % confirm that pchip agreed better to discontinuous data than spline
 
-%!shared x,y
+%!shared x,y,y2,pp,yi1,yi2,yi3
 %! x = 0:8;
 %! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0];
 %!assert (pchip(x,y,x), y);
@@ -148,3 +149,23 @@
 %!assert (isempty(pchip(x',y',[])));
 %!assert (isempty(pchip(x,y,[])));
 %!assert (pchip(x,[y;y],x), [pchip(x,y,x);pchip(x,y,x)])
+%!assert (pchip(x,[y;y],x'), [pchip(x,y,x);pchip(x,y,x)])
+%!assert (pchip(x',[y;y],x), [pchip(x,y,x);pchip(x,y,x)])
+%!assert (pchip(x',[y;y],x'), [pchip(x,y,x);pchip(x,y,x)])
+%!test
+%! x=(0:8)*pi/4;y=[sin(x);cos(x)];
+%! y2(:,:,1)=y;y2(:,:,2)=y+1;y2(:,:,3)=y-1;
+%! pp=pchip(x,shiftdim(y2,2));
+%! yi1=ppval(pp,(1:4)*pi/4);
+%! yi2=ppval(pp,repmat((1:4)*pi/4,[5,1]));
+%! yi3=ppval(pp,[pi/2,pi]);
+%!assert(size(pp.coefs),[48,4]);
+%!assert(pp.pieces,8);
+%!assert(pp.order,4);
+%!assert(pp.dim,[3,2]);
+%!assert(ppval(pp,pi),[0,-1;1,0;-1,-2],1e-14);
+%!assert(yi3(:,:,2),ppval(pp,pi),1e-14);
+%!assert(yi3(:,:,1),[1,0;2,1;0,-1],1e-14);
+%!assert(squeeze(yi1(1,2,:)),[1/sqrt(2); 0; -1/sqrt(2);-1],1e-14);
+%!assert(size(yi2),[3,2,5,4]);
+%!assert(squeeze(yi2(1,2,3,:)),[1/sqrt(2); 0; -1/sqrt(2);-1],1e-14);
\ No newline at end of file
--- a/scripts/polynomial/ppder.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/polynomial/ppder.m	Wed Feb 23 08:11:40 2011 +0100
@@ -17,28 +17,54 @@
 ## <http://www.gnu.org/licenses/>.
 
 ## -*- texinfo -*-
-## @deftypefn {Function File} {@var{ppd} =} ppder (@var{pp})
-## Compute the piecewise derivative of the piecewise polynomial struct @var{pp}.
+## @deftypefn {Function File} {ppd =} ppder (pp, m)
+## Computes the piecewise @var{m}-th derivative of a piecewise polynomial
+## struct @var{pp}. If @var{m} is omitted the first derivate is
+## calculated.
 ## @seealso{mkpp, ppval, ppint}
 ## @end deftypefn
 
-function ppd = ppder (pp)
-  if (nargin != 1)
+function ppd = ppder (pp, m)
+
+  if ((nargin < 1) || (nargin > 2))
     print_usage ();
+  elseif (nargin == 1)
+    m = 1;
   endif
-  if (! isstruct (pp))
+
+  if !(isstruct (pp) && strcmp (pp.form, "pp"))
     error ("ppder: PP must be a structure");
   endif
 
   [x, p, n, k, d] = unmkpp (pp);
-  p = reshape (p, [], k);
-  if (k <= 1)
-    pd = zeros (rows (p), 1);
-    k = 1;
+
+  if (k - m <= 0)
+    x = [x(1) x(end)];
+    pd = zeros (prod (d), 1);
   else
-    k -= 1;
-    pd = p(:,1:k) * diag (k:-1:1);
+    f = k : -1 : 1;
+    ff = bincoeff (f, m + 1) .* factorial (m + 1) ./ f;
+    k -= m;
+    pd = p(:,1:k) * diag (ff(1:k));
   endif
+
   ppd = mkpp (x, pd, d);
 endfunction
 
+%!shared x,y,pp,ppd
+%! x=0:8;y=[x.^2;x.^3+1];pp=spline(x,y);
+%! ppd=ppder(pp);
+%!assert(ppval(ppd,x),[2*x;3*x.^2],1e-14)
+%!assert(ppd.order,3)
+%! ppd=ppder(pp,2);
+%!assert(ppval(ppd,x),[2*ones(size(x));6*x],1e-14)
+%!assert(ppd.order,2)
+%! ppd=ppder(pp,3);
+%!assert(ppd.order,1)
+%!assert(ppd.pieces,8)
+%!assert(size(ppd.coefs),[16,1])
+%! ppd=ppder(pp,4);
+%!assert(ppd.order,1)
+%!assert(ppd.pieces,1)
+%!assert(size(ppd.coefs),[2,1])
+%!assert(ppval(ppd,x),zeros(size(y)),1e-14)
--- a/scripts/polynomial/ppint.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/polynomial/ppint.m	Wed Feb 23 08:11:40 2011 +0100
@@ -28,7 +28,7 @@
   if (nargin < 1 || nargin > 2)
     print_usage ();
   endif
-  if (! isstruct (pp))
+  if (! isstruct (pp) && strcmp (pp.form, "pp"))
     error ("ppint: PP must be a structure");
   endif
 
@@ -39,17 +39,20 @@
   pi = p / diag (k:-1:1);
   k += 1;
   if (nargin == 1)
-    pi(:,k) = 0;
+    pi(:, k) = 0;
   else
-    pi(:,k) = repmat (c(:), n, 1);
+    pi(:, k) = repmat (c(:), n, 1);
   endif
 
   ppi = mkpp (x, pi, d);
 
-  ## Adjust constants so the the result is continuous.
-
-  jumps = reshape (ppjumps (ppi), prod (d), n-1);
-  ppi.P(:,2:n,k) -= cumsum (jumps, 2);
-
+  tmp = -cumsum (ppjumps (ppi), length (d) + 1);
+  ppi.coefs(prod(d)+1:end, k) = tmp(:);
+  
 endfunction
 
+%!shared x,y,pp,ppi
+%! x=0:8;y=[ones(size(x));x+1];pp=spline(x,y);
+%! ppi=ppint(pp);
+%!assert(ppval(ppi,x),[x;0.5*x.^2+x],1e-14)
+%!assert(ppi.order,5)
--- a/scripts/polynomial/ppjumps.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/polynomial/ppjumps.m	Wed Feb 23 08:11:40 2011 +0100
@@ -28,29 +28,31 @@
   if (nargin != 1)
     print_usage ();
   endif
-  if (! isstruct (pp))
+  
+  if (! isstruct (pp) && strcmp (pp.form, "pp"))
     error ("ppjumps: PP must be a structure");
   endif
 
   ## Extract info.
-  x = pp.x;
-  P = pp.P;
-  d = pp.d;
-  [nd, n, k] = size (P);
+  [x, P, n, k, d] = unmkpp(pp);
+  nd = length (d) + 1;
 
   ## Offsets.
-  dx = diff (x(1:n)).';
-  dx = dx(ones (1, nd), :); # spread (do nothing in 1D)
+  dx = diff(x(1:n));
+  dx = repmat (dx, [prod(d), 1]);
+  dx = reshape (dx, [d, n-1]);
+  dx = shiftdim (dx, nd - 1);
 
-  ## Use Horner scheme to get limits from the left.
-  llim = P(:,1:n-1,1);
-  for i = 2:k;
+  ## Use Horner scheme.
+  if (k>1)
+    llim = shiftdim (reshape (P(1:(n-1) * prod(d), 1), [d, n-1]), nd - 1);
+  endif
+
+  for i = 2 : k;
     llim .*= dx;
-    llim += P(:,1:n-1,i);
+    llim += shiftdim (reshape (P(1:(n-1) * prod (d), i), [d, n-1]), nd - 1);
   endfor
-
-  rlim = P(:,2:n,k); # limits from the right
-  jumps = reshape (rlim - llim, [d, n-1]);
-
+  
+  rlim = shiftdim (ppval (pp, x(2:end-1)), nd - 1);
+  jumps = shiftdim (rlim - llim, 1);
 endfunction
-
--- a/scripts/polynomial/ppval.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/polynomial/ppval.m	Wed Feb 23 08:11:40 2011 +0100
@@ -18,16 +18,18 @@
 
 ## -*- texinfo -*-
 ## @deftypefn {Function File} {@var{yi} =} ppval (@var{pp}, @var{xi})
-## Evaluate piecewise polynomial @var{pp} at the points @var{xi}.
-## If @var{pp} is scalar-valued, the result is an array of the same shape as
-## @var{xi}.
-## Otherwise, the size of the result is @code{[pp.d, length(@var{xi})]} if
-## @var{xi} is a vector, or @code{[pp.d, size(@var{xi})]} if it is a
-## multi-dimensional array.  If pp.orient is 1, the dimensions are permuted as
+## Evaluate piece-wise polynomial structure @var{pp} at the points @var{xi}.  
+## If @var{pp} describes a scalar polynomial function, the result is an
+## array of the same shape as @var{xi}.
+## Otherwise, the size of the result is @code{[pp.dim, length(@var{xi})]} if
+## @var{xi} is a vector, or @code{[pp.dim, size(@var{xi})]} if it is a
+## multi-dimensional array.  
+##
+##, the dimensions are permuted as
 ## in interp1, to
 ## @code{[pp.d, length(@var{xi})]} and @code{[pp.d, size(@var{xi})]}
 ## respectively.
-## @seealso{mkpp, unmkpp, spline}
+## @seealso{mkpp, unmkpp, spline, pchip, interp1}
 ## @end deftypefn
 
 function yi = ppval (pp, xi)
@@ -35,48 +37,85 @@
   if (nargin != 2)
     print_usage ();
   endif
-  if (! isstruct (pp))
-    error ("ppval: PP must be a structure");
+  if (! isstruct (pp) && strcmp (pp.form, "pp"))
+    error ("ppval: expects a pp-form structure");
   endif
 
   ## Extract info.
-  x = pp.x;
-  P = pp.P;
-  d = pp.d;
-  k = size (P, 3);
-  nd = size (P, 1);
-
-  ## Determine resulting shape.
-  if (d == 1) # scalar case
-    yisz = size (xi);
-  elseif (isvector (xi)) # this is special
-    yisz = [d, length(xi)];
-  else # general
-    yisz = [d, size(xi)];
+  [x, P, n, k, d] = unmkpp (pp);
+  
+  ## dimension checks
+  sxi = size (xi);
+  if (isvector (xi))
+    xi = xi(:).';
   endif
+  
+  nd = length (d);
 
   ## Determine intervals.
-  xi = xi(:);
   xn = numel (xi);
-
   idx = lookup (x, xi, "lr");
 
+  P = reshape (P, [d, n * k]);
+  P = shiftdim (P, nd);
+  P = reshape (P, [n, k, d]);
+  Pidx = P(idx(:), :);#2d matrix size x: coefs*prod(d) y: prod(sxi)
+  
+  if (isvector(xi))
+    Pidx = reshape (Pidx, [xn, k, d]);
+    Pidx = shiftdim (Pidx, 1);
+    dimvec = [d, xn];
+  else
+    Pidx = reshape (Pidx, [sxi, k, d]);
+    Pidx = shiftdim (Pidx, length (sxi));
+    dimvec = [d, sxi];
+  end
+  ndv = length (dimvec);
+
   ## Offsets.
-  dx = (xi - x(idx)).';
-  dx = dx(ones (1, nd), :); # spread (do nothing in 1D)
+  dx = (xi - x(idx));
+  dx = repmat (dx, [prod(d), 1]);
+  dx = reshape (dx, dimvec);
+  dx = shiftdim (dx, ndv - 1);
 
   ## Use Horner scheme.
-  yi = P(:,idx,1);
-  for i = 2:k;
+  yi = Pidx;
+  if (k > 1)
+    yi = shiftdim (reshape (Pidx(1,:), dimvec), ndv - 1);
+  endif
+  
+  for i = 2 : k;
     yi .*= dx;
-    yi += P(:,idx,i);
+    yi += shiftdim (reshape (Pidx(i,:), dimvec), ndv - 1);
   endfor
-
+  
   ## Adjust shape.
-  yi = reshape (yi, yisz);
-  if (d != 1 && pp.orient == 1)
-    ## Switch dimensions to match interp1 order.
-    yi = shiftdim (yi, length (d));
+  if ((numel (xi) > 1) || (length (d) == 1))
+    yi = reshape (shiftdim (yi, 1), dimvec);
   endif
 
+  if (isvector (xi) && (d == 1))
+    yi = reshape (yi, sxi);
+  elseif (isfield (pp, "orient") && strcmp (pp.orient, "first"))
+    yi = shiftdim(yi, nd);
+  endif
+
+  ##
+  #if (d == 1)
+  #  yi = reshape (yi, sxi);
+  #endif
+  
 endfunction
+
+%!shared b,c,pp,pp2,xi,abserr
+%! b = 1:3; c = ones(2); pp=mkpp(b,c);abserr = 1e-14;pp2=mkpp(b,[c;c],2);
+%! xi = [1.1 1.3 1.9 2.1];
+%!assert (ppval(pp,1.1), 1.1, abserr);
+%!assert (ppval(pp,2.1), 1.1, abserr);
+%!assert (ppval(pp,xi), [1.1 1.3 1.9 1.1], abserr);
+%!assert (ppval(pp,xi.'), [1.1 1.3 1.9 1.1].', abserr);
+%!assert (ppval(pp2,1.1), [1.1;1.1], abserr);
+%!assert (ppval(pp2,2.1), [1.1;1.1], abserr);
+%!assert (ppval(pp2,xi), [1.1 1.3 1.9 1.1;1.1 1.3 1.9 1.1], abserr);
+%!assert (ppval(pp2,xi'), [1.1 1.3 1.9 1.1;1.1 1.3 1.9 1.1], abserr);
+%!assert (size(ppval(pp2,[xi;xi])), [2 2 4]);
--- a/scripts/polynomial/spline.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/polynomial/spline.m	Wed Feb 23 08:11:40 2011 +0100
@@ -83,15 +83,15 @@
   ## 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)
+  if (ndy == 2 && (szy(1) == n || szy(2) == n))
+    if (szy(2) == n)
       a = y.';
     else
       a = y;
       szy = fliplr (szy);
     endif
   else
-    a = reshape (y, [prod(szy(1:end-1)), szy(end)]).';
+    a = shiftdim (reshape (y, [prod(szy(1:end-1)), szy(end)]), 1);
   endif
 
   for k = (1:columns (a))(any (isnan (a)))
@@ -120,9 +120,9 @@
 
     if (n == 2)
       d = (dfs + dfe) / (x(2) - x(1)) ^ 2 + ...
-	2 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 3;
+          2 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 3;
       c = (-2 * dfs - dfe) / (x(2) - x(1)) - ...
-	3 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 2;
+          3 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 2;
       b = dfs;
       a = a(1,:);
 
@@ -132,7 +132,7 @@
       a = a(1:n-1,:);
     else
       if (n == 3)
-	dg = 1.5 * h(1) - 0.5 * h(2);
+        dg = 1.5 * h(1) - 0.5 * h(2);
         c(2:n-1,:) = 1/dg(1);
       else
         dg = 2 * (h(1:n-2) .+ h(2:n-1));
@@ -153,9 +153,9 @@
       endif
 
       c(1,:) = (3 / h(1) * (a(2,:) - a(1,:)) - 3 * dfs
-		- c(2,:) * h(1)) / (2 * h(1));
+             - c(2,:) * h(1)) / (2 * h(1));
       c(n,:) = - (3 / h(n-1) * (a(n,:) - a(n-1,:)) - 3 * dfe
-		  + c(n-1,:) * h(n-1)) / (2 * h(n-1));
+             + c(n-1,:) * h(n-1)) / (2 * h(n-1));
       b(1:n-1,:) = diff (a) ./ h(1:n-1, idx) ...
         - h(1:n-1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:));
       d = diff (c) ./ (3 * h(1:n-1, idx));
@@ -229,15 +229,14 @@
           - h(1:n-1, idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:));
       d = diff (c) ./ (3 * h(1:n-1, idx));
 
-      d = d(1:n-1,:);
-      c = c(1:n-1,:);
-      b = b(1:n-1,:);
-      a = a(1:n-1,:);
+      d = d(1:n-1,:);d = d.'(:);
+      c = c(1:n-1,:);c = c.'(:);
+      b = b(1:n-1,:);b = b.'(:);
+      a = a(1:n-1,:);a = a.'(:);
     endif
 
   endif
-  coeffs = cat (3, d.', c.', b.', a.');
-  ret = mkpp (x, coeffs, szy(1:end-1));
+  ret = mkpp (x, cat (2, d, c, b, a), szy(1:end-1));
 
   if (nargin == 3)
     ret = ppval (ret, xi);
@@ -263,6 +262,9 @@
 %!assert (isempty(spline(x',y',[])));
 %!assert (isempty(spline(x,y,[])));
 %!assert (spline(x,[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr)
+%!assert (spline(x,[y;y],x'), [spline(x,y,x);spline(x,y,x)],abserr)
+%!assert (spline(x',[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr)
+%!assert (spline(x',[y;y],x'), [spline(x,y,x);spline(x,y,x)],abserr)
 %! y = cos(x) + i*sin(x);
 %!assert (spline(x,y,x), y, abserr)
 %!assert (real(spline(x,y,x)), real(y), abserr);
--- a/scripts/polynomial/unmkpp.m	Wed Apr 13 21:36:31 2011 -0700
+++ b/scripts/polynomial/unmkpp.m	Wed Feb 23 08:11:40 2011 +0100
@@ -50,15 +50,13 @@
   if (nargin == 0)
     print_usage ();
   endif
-  if (! isstruct (pp))
+  if (! (isstruct (pp) && strcmp (pp.form, "pp")))
     error ("unmkpp: expecting piecewise polynomial structure");
   endif
-  x = pp.x;
-  P = pp.P;
-  n = size (P, 2);
-  k = size (P, 3);
-  d = pp.d;
-  if (d == 1)
-    P = reshape (P, n, k);
-  endif
+  x = pp.breaks;
+  P = pp.coefs;
+  n = pp.pieces;
+  k = pp.order;
+  d = pp.dim;
+
 endfunction