Commit c477e6bb authored by agebhard's avatar agebhard
Browse files

fix interpp.new

drop ncp parameter
parent b7940cf6
interp <- interp <-
function(x, y, z, function(x, y, z,
xo = seq(min(x), max(x), length = 40), xo = seq(min(x), max(x), length = 40),
yo = seq(min(y), max(y), length = 40), ncp = 0, yo = seq(min(y), max(y), length = 40), linear=TRUE,
extrap = FALSE, duplicate = "error", dupfun = NULL) extrap = FALSE, duplicate = "error", dupfun = NULL, ncp=NULL)
{ {
if (ncp == 0)
# for backward compatibility
if(!is.null(ncp)){
warning('use of \'ncp\' parameter is deprecated!')
if(ncp==0)
linear <- TRUE
else if(ncp>0)
linear <- FALSE
else
stop('ncp < 0 ?')
}
if(linear)
## use the old version for linear interpolation ## use the old version for linear interpolation
interp.old(x, y, z, xo = xo, yo = yo, ncp = ncp, interp.old(x, y, z, xo = xo, yo = yo, ncp = 0,
extrap = extrap, duplicate = duplicate, dupfun = dupfun) extrap = extrap, duplicate = duplicate, dupfun = dupfun)
else ## use the new one else ## use the new one
interp.new(x, y, z, xo = xo, yo = yo, linear = FALSE, interp.new(x, y, z, xo = xo, yo = yo, linear = FALSE,
......
"interpp"<-function(x, y, z, xo, yo, ncp = 0, extrap = FALSE, "interpp"<-function(x, y, z, xo, yo, linear = TRUE, extrap = FALSE,
duplicate = "error", dupfun = NULL) duplicate = "error", dupfun = NULL, ncp=NULL)
{ {
# interpp.new has some bugs at the moment (segfaults), so use
# the old Akima code: # for backward compatibility
interpp.old(x, y, z, xo, yo, ncp, extrap, duplicate, dupfun) if(!is.null(ncp)){
warning('use of \'ncp\' parameter is deprecated!')
if(ncp==0)
linear <- TRUE
else if(ncp>0)
linear <- FALSE
else
stop('ncp < 0 ?')
}
if(linear)
# the old Akima code:
interpp.old(x, y, z, xo, yo, ncp=0, extrap, duplicate, dupfun)
else
# new code for splines
interpp.new(x, y, z, xo, yo, extrap, duplicate, dupfun)
} }
"interpp.new"<-function(x, y, z, xo, yo, ncp = 0, extrap = FALSE, "interpp.new"<-function(x, y, z, xo, yo, extrap = FALSE,
duplicate = "error", dupfun = NULL) duplicate = "error", dupfun = NULL)
{ {
if(!(all(is.finite(x)) && all(is.finite(y)) && all(is.finite(z)))) if(!(all(is.finite(x)) && all(is.finite(y)) && all(is.finite(z))))
...@@ -7,10 +7,9 @@ ...@@ -7,10 +7,9 @@
stop("xo missing") stop("xo missing")
if(is.null(yo)) if(is.null(yo))
stop("yo missing") stop("yo missing")
if(ncp>25){
ncp <- 25
cat("ncp too large, using ncp=25\n")
}
drx <- diff(range(x)) drx <- diff(range(x))
dry <- diff(range(y)) dry <- diff(range(y))
if(drx == 0 || dry == 0) if(drx == 0 || dry == 0)
...@@ -58,11 +57,9 @@ ...@@ -58,11 +57,9 @@
storage.mode(zo) <- "double" storage.mode(zo) <- "double"
miss <- !extrap #if not extrapolating use missing values miss <- !extrap #if not extrapolating use missing values
extrap <- seq(TRUE, np) extrap <- seq(TRUE, np)
if(extrap & ncp == 0)
warning("Cannot extrapolate with linear option")
ans <- .Fortran("sdbi3p", ans <- .Fortran("sdbi3p",
as.integer(1), as.integer(1),
# as.integer(ncp),
as.integer(n), as.integer(n),
as.double(x), as.double(x),
as.double(y), as.double(y),
...@@ -71,11 +68,12 @@ ...@@ -71,11 +68,12 @@
x = as.double(xo), x = as.double(xo),
y = as.double(yo), y = as.double(yo),
z = zo, z = zo,
double(17 * n), ier = integer(1),
integer(25 * n), wk = double(17 * n),
iwk = integer(25 * n),
extrap = as.logical(extrap), extrap = as.logical(extrap),
near = integer(n), near = integer(n),
net = integer(n), nxt = integer(n),
dist = double(n), dist = double(n),
PACKAGE = "akima") PACKAGE = "akima")
temp <- ans[c("x", "y", "z", "extrap")] temp <- ans[c("x", "y", "z", "extrap")]
......
...@@ -12,7 +12,7 @@ ...@@ -12,7 +12,7 @@
\usage{ \usage{
interp(x, y, z, xo=seq(min(x), max(x), length = 40), interp(x, y, z, xo=seq(min(x), max(x), length = 40),
yo=seq(min(y), max(y), length = 40), yo=seq(min(y), max(y), length = 40),
ncp = 0, extrap=FALSE, duplicate = "error", dupfun = NULL) linear = TRUE, extrap=FALSE, duplicate = "error", dupfun = NULL, ncp = NULL)
interp.old(x, y, z, xo= seq(min(x), max(x), length = 40), interp.old(x, y, z, xo= seq(min(x), max(x), length = 40),
yo=seq(min(y), max(y), length = 40), ncp = 0, yo=seq(min(y), max(y), length = 40), ncp = 0,
extrap=FALSE, duplicate = "error", dupfun = NULL) extrap=FALSE, duplicate = "error", dupfun = NULL)
...@@ -53,8 +53,12 @@ interp.new(x, y, z, xo = seq(min(x), max(x), length = 40), ...@@ -53,8 +53,12 @@ interp.new(x, y, z, xo = seq(min(x), max(x), length = 40),
} }
\item{yo}{vector of y-coordinates of output grid; analogous to \item{yo}{vector of y-coordinates of output grid; analogous to
\code{xo}, see above.} \code{xo}, see above.}
\item{linear}{logical, switch to linear interpolation in \code{interp.new}.} \item{linear}{logical -- indicating wether linear or spline
interpolation should be used. supersedes old \code{ncp} parameter}
\item{ncp}{ \item{ncp}{
deprecated, use parameter \code{linear}.
meaning was:
number of additional points to be used in computing partial number of additional points to be used in computing partial
derivatives at each data point. derivatives at each data point.
\code{ncp} must be either \code{0} (partial derivatives are not used), or at \code{ncp} must be either \code{0} (partial derivatives are not used), or at
......
...@@ -6,7 +6,8 @@ ...@@ -6,7 +6,8 @@
\alias{interpp.old} \alias{interpp.old}
\alias{interpp.new} \alias{interpp.new}
\usage{ \usage{
interpp(x, y, z, xo, yo, ncp=0, extrap=FALSE, duplicate = "error", dupfun = NULL) interpp(x, y, z, xo, yo, linear=TRUE, extrap=FALSE, duplicate = "error",
dupfun = NULL, ncp)
} }
\arguments{ \arguments{
\item{x}{ \item{x}{
...@@ -33,18 +34,22 @@ interpp(x, y, z, xo, yo, ncp=0, extrap=FALSE, duplicate = "error", dupfun = NULL ...@@ -33,18 +34,22 @@ interpp(x, y, z, xo, yo, ncp=0, extrap=FALSE, duplicate = "error", dupfun = NULL
\item{yo}{ \item{yo}{
vector of y-coordinates of points at which to evaluate the interpolating vector of y-coordinates of points at which to evaluate the interpolating
function.} function.}
\item{linear}{logical -- indicating wether linear or spline
\item{ncp}{ interpolation should be used. supersedes old \code{ncp} parameter}
number of additional points to be used in computing partial \item{ncp}{
derivatives at each data point. deprecated, use parameter \code{linear}.
\code{ncp} must be either \code{0} (partial derivatives are not used, =
linear interpolation), or at meaning was:
least 2 but smaller than the number of data points (and smaller than 25). number of additional points to be used in computing partial
} derivatives at each data point.
\item{extrap}{ \code{ncp} must be either \code{0} (partial derivatives are not used, =
logical flag: should extrapolation be used outside of the linear interpolation), or at
convex hull determined by the data points?} least 2 but smaller than the number of data points (and smaller than 25).
\item{duplicate}{ }
\item{extrap}{
logical flag: should extrapolation be used outside of the
convex hull determined by the data points?}
\item{duplicate}{
indicates how to handle duplicate data points. Possible values are indicates how to handle duplicate data points. Possible values are
\code{"error"} - produces an error message, \code{"strip"} - remove \code{"error"} - produces an error message, \code{"strip"} - remove
duplicate z values, \code{"mean"},\code{"median"},\code{"user"} - duplicate z values, \code{"mean"},\code{"median"},\code{"user"} -
...@@ -115,5 +120,10 @@ interpp(x, y, z, xo, yo, ncp=0, extrap=FALSE, duplicate = "error", dupfun = NULL ...@@ -115,5 +120,10 @@ interpp(x, y, z, xo, yo, ncp=0, extrap=FALSE, duplicate = "error", dupfun = NULL
data(akima) data(akima)
# linear interpolation at points (1,2), (5,6) and (10,12) # linear interpolation at points (1,2), (5,6) and (10,12)
akima.lip<-interpp(akima$x, akima$y, akima$z,c(1,5,10),c(2,6,12)) akima.lip<-interpp(akima$x, akima$y, akima$z,c(1,5,10),c(2,6,12))
akima.lip$z
# spline interpolation
akima.lip<-interpp(akima$x, akima$y, akima$z,c(1,5,10),c(2,6,12),
linear=FALSE)
akima.lip$z
} }
\keyword{dplot} \keyword{dplot}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment