bsplineS <- function (x, breaks, norder=4, nderiv=0) { # This is a wrapper function for the S-PLUS spline.des function. # The number of spline functions is equal to the number of # discrete break points, length(BREAKVALUES), plus the order, NORDER, # minus 2. # Arguments are as follows: # X ... array of values at which the spline functions are to # evaluated # BREAKS ... a STRICTLY INCREASING sequence of break points or knot # values. It must contain all the values of X within its # range. # NORDER ... order of spline (1 more than degree), so that 1 gives a # step function, 2 gives triangle functions, # and 4 gives cubic splines # NDERIV ... highest order derivative. 0 means only function values # are returned. # Return is a matrix with length(X) rows and number of columns equal to # number of b-splines # last modified 27 October 2008 by Jim Ramsay x <- as.vector(x) n <- length(x) tol <- 1e-14 nbreaks <- length(breaks) if (nbreaks < 2) stop('Number of knots less than 2.') if (min(diff(breaks)) < 0 ) stop('Knots are not increasing') if ( max(x) > max(breaks) + tol || min(x) < min(breaks) - tol ) stop('Knots do not span the values of X') if ( x[n] > breaks[nbreaks]) breaks[nbreaks] <- x[n] if ( x[1] < breaks[1] ) breaks[1] <- x[1] if (norder > 20) stop('NORDER exceeds 20.') if (norder < 1) stop('NORDER less than 1.') if (nderiv > 19) stop('NDERIV exceeds 19.') if (nderiv < 0) stop('NDERIV is negative.') if (nderiv >= norder) stop ( 'NDERIV cannot be as large as order of B-spline.') knots <- c(rep(breaks[1 ],norder-1), breaks, rep(breaks[nbreaks],norder-1) ) derivs <- rep(nderiv,n) nbasis <- nbreaks + norder - 2 if (nbasis >= norder) { basismat <- spline.des(knots, x, norder, derivs)$design } else { stop("NBASIS is less than NORDER.") } }