splines2/ 0000755 0001762 0000144 00000000000 13310535463 012014 5 ustar ligges users splines2/inst/ 0000755 0001762 0000144 00000000000 13310532503 012761 5 ustar ligges users splines2/inst/CITATION 0000644 0001762 0000144 00000001234 13310532500 014113 0 ustar ligges users citHeader("To cite splines2 in publications use:")
citEntry(entry = "Manual",
Title = "{splines2}: {R}egression Spline Functions and Classes",
Author = personList(as.person("Wenjie Wang"),
as.person("Jun Yan")),
Note = "{R} package version 0.2.8",
Year = "2018",
Url = "https://CRAN.R-project.org/package=splines2",
textVersion = paste("Wang, W., Yan, J. (2018). splines2:",
"Regression Spline Functions and Classes.",
"R package version 0.2.8.",
"https://CRAN.R-project.org/package=splines2")
)
splines2/inst/bib/ 0000755 0001762 0000144 00000000000 13303652501 013520 5 ustar ligges users splines2/inst/bib/splines2.bib 0000644 0001762 0000144 00000001521 13210312372 015730 0 ustar ligges users @book{de1978practical,
title = {A Practical Guide to Splines},
author = {De Boor, Carl},
volume = 27,
year = 1978,
publisher = Springer-Verlag,
Address = {New York},
doi = {10.1002/zamm.19800600129}
}
@article{meyer2008inference,
title = {Inference Using Shape-Restricted Regression Splines},
author = {Meyer, Mary C},
journal = {The Annals of Applied Statistics},
pages = {1013--1033},
year = 2008,
publisher = {JSTOR},
doi = {10.1214/08-AOAS167}
}
@article{ramsay1988monotone,
title = {Monotone Regression Splines in Action},
author = {Ramsay, J O},
journal = {Statistical Science},
pages = {425--441},
year = 1988,
publisher = {JSTOR},
doi = {10.1214/ss/1177012761}
}
splines2/inst/doc/ 0000755 0001762 0000144 00000000000 13310532503 013526 5 ustar ligges users splines2/inst/doc/splines2-intro.html 0000644 0001762 0000144 00001137467 13310532503 017327 0 ustar ligges users
Introduction to splines2
Introduction to splines2
Wenjie Wang
2018-06-14
The package splines2 is designed to be a supplementary package on splines. It provides functions constructing a variety of spline bases that are not available from the package splines shipped with R. Most functions have a very similar user interface with the function bs
in package splines. Currently, splines2 provides function constructing B-splines, integral of B-splines, monotone splines (M-splines) and its integral (I-splines), convex splines (C-splines), and their derivatives. Compared with package splines, splines2 allows piecewise constant basis for B-splines. Also, it provides a more user-friendly function interface, more consistent handling on NA
’s for spline derivatives.
In this vignette, we introduce the basic usage of the functions provided by examples. The details of function syntax are available in the package manual and thus will be not discussed.
An outline of the remainder of the vignette is as follows: We first introduce the functions constructing the monotone splines (M-splines), its integral (I-splines), and convex splines (C-splines). The deriv
methods for derivatives is demonstrated at the same time. After then, toy examples for integral and derivative of B-splines and B-splines, M-splines allowing piecewise constant are given. Last but not the least, handy methods of S3 generic function predict for objects produced by splines2 are demonstrated for the evaluation of the same spline basis at new values.
M-splines using mSpline
M-splines (Ramsay 1988) can be considered as a normalized version of B-splines with unit integral within boundary knots. An example given by Ramsay (1988) was a quadratic M-splines with three internal knots placed at 0.3, 0.5, and 0.6. The boundary knots by default are the range of the data x
, thus 0 and 1 in this example.
library(splines2)
knots <- c(0.3, 0.5, 0.6)
x <- seq(0, 1, 0.01)
msOut <- mSpline(x, knots = knots, degree = 2, intercept = TRUE)
library(graphics) # attach graphics (just in case) for plots
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, msOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray") # mark internal knots
The derivative of given order of M-splines can be obtained by specifying a positive integer to argument dervis
of mSpline
. Also, for an existing mSpline
object generated from function mSpline
, the deriv
method can be used conveniently. For example, the first derivative of the M-splines given in last example can be obtained equivalently as follows:
I-splines using iSpline
I-splines (Ramsay 1988) are simply the integral of M-splines and thus monotonically non-decreasing with unit maximum value. A monotonically non-decreasing (non-increasing) function can be fitted by a linear combination of I-spline bases with non-negative (non-positive) coefficients, plus a constant function (where the coefficient of the constant function is unconstrained).
The example given by Ramsay (1988) was the I-splines corresponding to that quadratic M-splines with three internal knots placed at 0.3, 0.5, and 0.6. Note that the degree of I-splines is defined from the associated M-splines instead of their own polynomial degree.
isOut <- iSpline(x, knots = knots, degree = 2, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, isOut, type = "l", ylab = "y")
abline(h = 1, v = knots, lty = 2, col = "gray")
The corresponding M-spline basis matrix can be obtained easily by the deriv
method, which internally exacts the attribute named msMat
in the object returned by function iSpline
. In other words, if we need both M-spline bases and their integral splines in model fitting, iSpline
and its deriv
method should be used, while an extra function call of mSpline
should be avoided for a better performance.
C-splines using cSpline
Convex splines (Meyer 2008) called C-splines are a scaled version of I-splines’ integral with unit maximum value. Meyer (2008) applied C-splines to shape-restricted regression analysis. The monotone property of I-spines ensures the convexity of C-splines. A convex regression function can be estimated using linear combinations of the C-spline bases with non-negative coefficients, plus an unrestricted linear combination of the constant function and the identity function \(g(x)=x\). If the underlying regression function is both increasing and convex, the coefficient on the identity function is restricted to be nonnegative as well.
Function cSpline
provides argument scale
specifying whether scaling on C-spline bases is required. If scale = TRUE
(by default), each C-spline basis is scaled to have unit height at right boundary knot. For its first (second) derivative, the deriv
method can be used, which internally exacts the corresponding I-spline (M-spline) bases shipped in attributes isMat
(msMat
) scaled to the same extent. The derivatives of higher order can be obtained by specifying argument derivs
in the deriv
method.
csOut1 <- cSpline(x, knots = knots, degree = 2, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, csOut1, type = "l", ylab = "y")
abline(h = 1, v = knots, lty = 2, col = "gray")
If scale = FALSE
, the actual integral of I-spline basis will be returned. Similarly, the corresponding deriv
method is provided. For derivatives of order greater than one, the nested call of deriv
is supported. However, argument derivs
can be specified if possible for a better performance. For example, the first and second derivatives can be obtained by the following equivalent approaches, respectively.
csOut2 <- cSpline(x, knots = knots, degree = 2, intercept = TRUE, scale = FALSE)
stopifnot(all.equal(isOut, deriv(csOut2), check.attributes = FALSE))
stopifnot(all.equal(msOut, deriv(csOut2, 2), deriv(deriv(csOut2)),
check.attributes = FALSE))
Integral and derivative of B-splines using ibs
and dbs
A close-form recursive formulas of B-spline integral and derivative given by De Boor (1978) are implemented. Two toy example are given as follows:
ibsOut <- ibs(x, knots = knots, degree = 1, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, deriv(ibsOut), type = "l", ylab = "y")
abline(v = knots, h = 1, lty = 2, col = "gray")
matplot(x, ibsOut, type = "l", ylab = "y")
abline(v = knots, h = c(0.15, 0.2, 0.25), lty = 2, col = "gray")
dbsOut <- dbs(x, knots = knots, intercept = TRUE)
bsOut <- bSpline(x, knots = knots, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, bsOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
matplot(x, dbsOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
B-splines using bSpline
Function bSpline
provides B-spline bases and allows degree = 0
for piecewise constant bases, which is one simple but handy extension to function bs
in package splines. (For positive degree
, bSpline
internally call bs
to do the hard work.) Step function or piecewise constant bases (close on the left and open on the right) are often used in practice for a reasonable approximation without any assumption on the form of target function. One simple example of B-splines and M-splines of degree zero is given as follows:
bsOut0 <- bSpline(x, knots = knots, degree = 0, intercept = TRUE)
msOut0 <- mSpline(x, knots = knots, degree = 0, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, bsOut0, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
matplot(x, msOut0, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
Evaluation on New Values by predict
The methods for splines2 objects dispatched by generic function predict
are useful if we want to evaluate the spline object at possibly new \(x\) values. For instance, if we want to evaluate the value of I-splines object in previous example at 0.275, 0.525, and 0.8, respectively, all we need is
## 1 2 3 4 5 6
## [1,] 0.9994213 0.7730556 0.2310764 0.0000000 0.000000 0.000
## [2,] 1.0000000 1.0000000 0.9765625 0.2696429 0.000625 0.000
## [3,] 1.0000000 1.0000000 1.0000000 0.9428571 0.580000 0.125
Technically speaking, the methods take all information needed, such as knots
, degree
, intercept
, etc., from attributes of the original splines2 objects and call the corresponding function automatically for those new \(x\) values. Therefore, the predict
methods will not be applicable if those attributes are somehow lost after certain operation.
splines2/inst/doc/splines2-intro.R 0000644 0001762 0000144 00000006344 13310532502 016547 0 ustar ligges users ## ----mSpline, fig.width=7, fig.height=4, fig.cap = "Quadratic M-splines with three internal knots."----
library(splines2)
knots <- c(0.3, 0.5, 0.6)
x <- seq(0, 1, 0.01)
msOut <- mSpline(x, knots = knots, degree = 2, intercept = TRUE)
library(graphics) # attach graphics (just in case) for plots
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, msOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray") # mark internal knots
## ----mSpline-derivs------------------------------------------------------
dmsOut1 <- mSpline(x, knots = knots, degree = 2, intercept = TRUE, derivs = 1)
dmsOut2 <- deriv(msOut)
stopifnot(all.equal(dmsOut1, dmsOut2, check.attributes = FALSE))
## ----iSpline, fig.width=7, fig.height=4, fig.cap = "I-splines of degree two with three internal knots."----
isOut <- iSpline(x, knots = knots, degree = 2, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, isOut, type = "l", ylab = "y")
abline(h = 1, v = knots, lty = 2, col = "gray")
## ----msMat---------------------------------------------------------------
stopifnot(all.equal(msOut, deriv(isOut)))
## ----cSpline-scaled, fig.width=7, fig.height=4, fig.cap = "C-splines of degree two with three internal knots."----
csOut1 <- cSpline(x, knots = knots, degree = 2, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, csOut1, type = "l", ylab = "y")
abline(h = 1, v = knots, lty = 2, col = "gray")
## ----cSpline-not-scaled--------------------------------------------------
csOut2 <- cSpline(x, knots = knots, degree = 2, intercept = TRUE, scale = FALSE)
stopifnot(all.equal(isOut, deriv(csOut2), check.attributes = FALSE))
stopifnot(all.equal(msOut, deriv(csOut2, 2), deriv(deriv(csOut2)),
check.attributes = FALSE))
## ----ibs, fig.width=7, fig.height=4, fig.cap="Piecewise linear B-splines (left) and their integrals (right)."----
ibsOut <- ibs(x, knots = knots, degree = 1, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, deriv(ibsOut), type = "l", ylab = "y")
abline(v = knots, h = 1, lty = 2, col = "gray")
matplot(x, ibsOut, type = "l", ylab = "y")
abline(v = knots, h = c(0.15, 0.2, 0.25), lty = 2, col = "gray")
## ----dbs, fig.width=7, fig.height=4, fig.cap="Cubic B-splines (left) and their first derivative (right)."----
dbsOut <- dbs(x, knots = knots, intercept = TRUE)
bsOut <- bSpline(x, knots = knots, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, bsOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
matplot(x, dbsOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
## ----bSpline, fig.width=7, fig.height=4, fig.cap="B-splines (left) and M-splines (right) of degree zero"----
bsOut0 <- bSpline(x, knots = knots, degree = 0, intercept = TRUE)
msOut0 <- mSpline(x, knots = knots, degree = 0, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, bsOut0, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
matplot(x, msOut0, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
## ----predict-------------------------------------------------------------
predict(isOut, c(0.275, 0.525, 0.8))
splines2/inst/doc/splines2-intro.Rmd 0000644 0001762 0000144 00000023350 13155556756 017114 0 ustar ligges users ---
title: "Introduction to splines2"
author: Wenjie Wang
date: "`r Sys.Date()`"
bibliography:
- ../inst/bib/splines2.bib
vignette: >
%\VignetteIndexEntry{Introduction to splines2}
%\VignetteEngine{knitr::rmarkdown}
\usepackage[utf8]{inputenc}
output: rmarkdown::html_vignette
---
The package **splines2** is designed to be a supplementary package on splines.
It provides functions constructing a variety of spline bases that are not
available from the package **splines** shipped with **R**. Most functions have
a very similar user interface with the function `bs` in package
**splines**. Currently, **splines2** provides function constructing B-splines,
integral of B-splines, monotone splines (M-splines) and its integral
(I-splines), convex splines (C-splines), and their derivatives. Compared with
package **splines**, **splines2** allows piecewise constant basis for B-splines.
Also, it provides a more user-friendly function interface, more consistent
handling on `NA`'s for spline derivatives.
In this vignette, we introduce the basic usage of the functions provided by
examples. The details of function syntax are available in the package manual and
thus will be not discussed.
An outline of the remainder of the vignette is as follows: We first introduce
the functions constructing the monotone splines ([M-splines](#mSpline)), its
integral ([I-splines](#iSpline)), and convex splines ([C-splines](#cSpline)).
The `deriv` methods for derivatives is demonstrated at the same time. After
then, toy examples for [integral and derivative of B-splines](#ibs-dbs)
and [B-splines](#bSpline), M-splines allowing piecewise constant are given.
Last but not the least, handy methods of S3 generic function [predict](#predict)
for objects produced by **splines2** are demonstrated for the evaluation of the
same spline basis at new values.
## M-splines using `mSpline`{#mSpline}
M-splines [@ramsay1988monotone] can be considered as a normalized version of
B-splines with unit integral within boundary knots. An example given by
@ramsay1988monotone was a quadratic M-splines with three internal knots placed
at 0.3, 0.5, and 0.6. The boundary knots by default are the range of the data
`x`, thus 0 and 1 in this example.
```{r mSpline, fig.width=7, fig.height=4, fig.cap = "Quadratic M-splines with three internal knots."}
library(splines2)
knots <- c(0.3, 0.5, 0.6)
x <- seq(0, 1, 0.01)
msOut <- mSpline(x, knots = knots, degree = 2, intercept = TRUE)
library(graphics) # attach graphics (just in case) for plots
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, msOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray") # mark internal knots
```
The derivative of given order of M-splines can be obtained by specifying a
positive integer to argument `dervis` of `mSpline`. Also, for an existing
`mSpline` object generated from function `mSpline`, the `deriv` method can be
used conveniently. For example, the first derivative of the M-splines given
in last example can be obtained equivalently as follows:
```{r mSpline-derivs}
dmsOut1 <- mSpline(x, knots = knots, degree = 2, intercept = TRUE, derivs = 1)
dmsOut2 <- deriv(msOut)
stopifnot(all.equal(dmsOut1, dmsOut2, check.attributes = FALSE))
```
## I-splines using `iSpline` {#iSpline}
I-splines [@ramsay1988monotone] are simply the integral of M-splines and thus
monotonically non-decreasing with unit maximum value. A monotonically
non-decreasing (non-increasing) function can be fitted by a linear combination
of I-spline bases with non-negative (non-positive) coefficients, plus a constant
function (where the coefficient of the constant function is unconstrained).
The example given by @ramsay1988monotone was the I-splines corresponding to that
quadratic M-splines with three internal knots placed at 0.3, 0.5, and 0.6. Note
that the degree of I-splines is defined from the associated M-splines instead of
their own polynomial degree.
```{r iSpline, fig.width=7, fig.height=4, fig.cap = "I-splines of degree two with three internal knots."}
isOut <- iSpline(x, knots = knots, degree = 2, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, isOut, type = "l", ylab = "y")
abline(h = 1, v = knots, lty = 2, col = "gray")
```
The corresponding M-spline basis matrix can be obtained easily by the `deriv`
method, which internally exacts the attribute named `msMat` in the object
returned by function `iSpline`. In other words, if we need both M-spline bases
and their integral splines in model fitting, `iSpline` and its `deriv` method
should be used, while an extra function call of `mSpline` should be avoided for
a better performance.
```{r msMat}
stopifnot(all.equal(msOut, deriv(isOut)))
```
## C-splines using `cSpline` {#cSpline}
Convex splines [@meyer2008inference] called C-splines are a scaled version of
I-splines' integral with unit maximum value. @meyer2008inference applied
C-splines to shape-restricted regression analysis. The monotone property of
I-spines ensures the convexity of C-splines. A convex regression function can be
estimated using linear combinations of the C-spline bases with non-negative
coefficients, plus an unrestricted linear combination of the constant function
and the identity function $g(x)=x$. If the underlying regression function is
both increasing and convex, the coefficient on the identity function is
restricted to be nonnegative as well.
Function `cSpline` provides argument `scale` specifying whether scaling on
C-spline bases is required. If `scale = TRUE` (by default), each C-spline basis
is scaled to have unit height at right boundary knot. For its first (second)
derivative, the `deriv` method can be used, which internally exacts the
corresponding I-spline (M-spline) bases shipped in attributes `isMat` (`msMat`)
scaled to the same extent. The derivatives of higher order can be obtained by
specifying argument `derivs` in the `deriv` method.
```{r cSpline-scaled, fig.width=7, fig.height=4, fig.cap = "C-splines of degree two with three internal knots."}
csOut1 <- cSpline(x, knots = knots, degree = 2, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, csOut1, type = "l", ylab = "y")
abline(h = 1, v = knots, lty = 2, col = "gray")
```
If `scale = FALSE`, the actual integral of I-spline basis will be returned.
Similarly, the corresponding `deriv` method is provided. For derivatives of
order greater than one, the nested call of `deriv` is supported. However,
argument `derivs` can be specified if possible for a better performance. For
example, the first and second derivatives can be obtained by the following
equivalent approaches, respectively.
```{r cSpline-not-scaled}
csOut2 <- cSpline(x, knots = knots, degree = 2, intercept = TRUE, scale = FALSE)
stopifnot(all.equal(isOut, deriv(csOut2), check.attributes = FALSE))
stopifnot(all.equal(msOut, deriv(csOut2, 2), deriv(deriv(csOut2)),
check.attributes = FALSE))
```
## Integral and derivative of B-splines using `ibs` and `dbs` {#ibs-dbs}
A close-form recursive formulas of B-spline integral and derivative given by
@de1978practical are implemented. Two toy example are given as follows:
```{r ibs, fig.width=7, fig.height=4, fig.cap="Piecewise linear B-splines (left) and their integrals (right)."}
ibsOut <- ibs(x, knots = knots, degree = 1, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, deriv(ibsOut), type = "l", ylab = "y")
abline(v = knots, h = 1, lty = 2, col = "gray")
matplot(x, ibsOut, type = "l", ylab = "y")
abline(v = knots, h = c(0.15, 0.2, 0.25), lty = 2, col = "gray")
```
```{r dbs, fig.width=7, fig.height=4, fig.cap="Cubic B-splines (left) and their first derivative (right)."}
dbsOut <- dbs(x, knots = knots, intercept = TRUE)
bsOut <- bSpline(x, knots = knots, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, bsOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
matplot(x, dbsOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
```
## B-splines using `bSpline` {#bSpline}
Function `bSpline` provides B-spline bases and allows `degree = 0` for piecewise
constant bases, which is one simple but handy extension to function `bs` in
package **splines**. (For positive `degree`, `bSpline` internally call `bs` to
do the hard work.) Step function or piecewise constant bases (close on the left
and open on the right) are often used in practice for a reasonable approximation
without any assumption on the form of target function. One simple example of
B-splines and M-splines of degree zero is given as follows:
```{r bSpline, fig.width=7, fig.height=4, fig.cap="B-splines (left) and M-splines (right) of degree zero"}
bsOut0 <- bSpline(x, knots = knots, degree = 0, intercept = TRUE)
msOut0 <- mSpline(x, knots = knots, degree = 0, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, bsOut0, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
matplot(x, msOut0, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
```
## Evaluation on New Values by `predict` {#predict}
The methods for **splines2** objects dispatched by generic function `predict`
are useful if we want to evaluate the spline object at possibly new $x$
values. For instance, if we want to evaluate the value of I-splines object in
previous example at 0.275, 0.525, and 0.8, respectively, all we need is
```{r predict}
predict(isOut, c(0.275, 0.525, 0.8))
```
Technically speaking, the methods take all information needed, such as `knots`,
`degree`, `intercept`, etc., from attributes of the original **splines2**
objects and call the corresponding function automatically for those new $x$
values. Therefore, the `predict` methods will not be applicable if those
attributes are somehow lost after certain operation.
## Reference
splines2/tests/ 0000755 0001762 0000144 00000000000 13303651340 013151 5 ustar ligges users splines2/tests/testthat.R 0000644 0001762 0000144 00000000075 13155556756 015162 0 ustar ligges users library(testthat)
library(splines2)
test_check("splines2")
splines2/tests/testthat/ 0000755 0001762 0000144 00000000000 13310535463 015016 5 ustar ligges users splines2/tests/testthat/test-bSpline.R 0000644 0001762 0000144 00000007177 13310532342 017517 0 ustar ligges users context("Testing bSpline")
test_that("call splines::bs", {
x <- c(NA, seq.int(0, 0.5, 0.1), NA, seq.int(0.6, 1, 0.1), NA)
knots <- c(0.25, NA, 0.5, 0.75, NA)
## for ease of testing
bsFun <- function(x, df, knots, degree, intercept, Boundary.knots) {
funCall <- match.call()
funCall[[1L]] <- quote(splines::bs)
bsMat <- eval(funCall)
class(bsMat) <- "matrix"
bsMat
}
expect_equivalent(bSpline(x), bsFun(x))
expect_equivalent(bSpline(x, df = 5), bsFun(x, df = 5))
expect_equivalent(bSpline(x, knots = knots), bsFun(x, knots = knots))
expect_equivalent(bSpline(x, degree = 2L), bsFun(x, degree = 2L))
expect_equivalent(bSpline(x, intercept = TRUE), bsFun(x, intercept = TRUE))
expect_equivalent(bSpline(x, knots = knots, intercept = TRUE),
bsFun(x, knots = knots, intercept = TRUE))
})
test_that("outputs of piecewise constant bases", {
x <- c(NA, seq.int(0, 0.5, 0.1), NA, seq.int(0.6, 1, 0.1), NA)
knots <- c(0.25, NA, 0.5, 0.75, NA)
## for testing splines with degree zero
bsMat0a <- bSpline(x, degree = 0, intercept = TRUE)
bsMat0b <- bSpline(x, df = 5, degree = 0)
bsMat0c <- bSpline(x, df = 5, degree = 0, intercept = TRUE)
bsMat0d <- bSpline(x, knots = knots, degree = 0)
bsMat0e <- bSpline(x, knots = knots, degree = 0, intercept = TRUE)
expect_equal(isNumMatrix(bsMat0a, 14L, 1L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(sum(is.na(bsMat0b)), 15L) # keep NA's as is
expect_equal(isNumMatrix(bsMat0b, 14L, 5L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(bsMat0c, 14L, 5L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(bsMat0d, 14L, 3L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(bsMat0e, 14L, 4L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(bSpline(x, df = 10, knots = knots, degree = 0L),
14L, 3L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(bSpline(x, df = 10, knots = knots,
degree = 0, intercept = TRUE),
14L, 4L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_error(bSpline(x, degree = 0),
"'intercept' has to be 'TRUE'", fixed = TRUE)
expect_warning(bSpline(x, df = 1, knots = 0.5, degree = 0),
"'df' specified was not appropriate.", fixed = TRUE)
expect_warning(bSpline(x, df = 3, knots = 0.5, degree = 0),
"'df' specified was not appropriate.", fixed = TRUE)
expect_warning(bSpline(x, knots = c(- 1, 0.5), degree = 0),
"internal knots placed inside", fixed = TRUE)
expect_warning(bSpline(x, knots = 0.5, degree = 0, Boundary.knots = 0:2),
"the first two values", fixed = TRUE)
expect_warning(bSpline(c(x, 10), knots = knots, degree = 0,
Boundary.knots = c(0, 1)),
"beyond boundary knots", fixed = TRUE)
})
## true close form formula given the all knots and degree
test_that("two internal knots, degree 0", {
## test with two internal knots
x <- seq.int(0, 5, 0.1)
knots <- c(1, NA, 3)
b0_1 <- function(x) as.numeric(x >= 0 & x < 1)
b0_2 <- function(x) as.numeric(x >= 1 & x < 3)
b0_3 <- function(x) as.numeric(x >= 3 & x < 5)
expect_equivalent(bSpline(x, knots = knots, degree = 0L, intercept = TRUE),
cbind(b0_1(x), b0_2(x), b0_3(x)))
})
splines2/tests/testthat/test-iSpline.R 0000644 0001762 0000144 00000003050 13210312372 017506 0 ustar ligges users context("Testing iSpline")
test_that("check equal dimension", {
x <- seq.int(0, 10, 0.5)
knots <- c(3, NA, 5, 7, NA)
expect_equal(isNumMatrix(iSpline(x), 21L, 3L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(iSpline(x, intercept = TRUE), 21L, 4L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(iSpline(x, derivs = 1), mSpline(x))
expect_equal(iSpline(x, df = 5, knots = knots, derivs = 1),
mSpline(x, df = 5, knots = knots))
expect_error(iSpline(x, knots = knots, derivs = - 1.1))
expect_warning(iSpline(x, df = 2))
expect_equal(isNumMatrix(iSpline(x, df = 3), 21L, 3L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(iSpline(x, df = 5), 21L, 5L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(iSpline(x, knots = knots, degree = 2),
21L, 5L, warn_na = FALSE, error_na = FALSE),
TRUE)
expect_equal(isNumMatrix(iSpline(x, knots = knots), 21L, 6L,
warn_na = FALSE, error_na = FALSE),
TRUE)
expect_equal(isNumMatrix(iSpline(x, knots = knots, intercept = TRUE),
21L, 7L, warn_na = FALSE, error_na = FALSE),
TRUE)
expect_equal(isNumMatrix(iSpline(x, knots = knots, intercept = TRUE),
21L, 7L, warn_na = FALSE, error_na = FALSE),
TRUE)
})
splines2/tests/testthat/test-deriv.R 0000644 0001762 0000144 00000007627 13210312372 017232 0 ustar ligges users context("Testing deriv methods")
x <- c(seq.int(0, 1, 0.1), NA)
knots <- c(0.3, NA, 0.5, 0.6, NA)
test_that("test deriv methods for B-splines related", {
ibsMat <- ibs(x, knots = knots, intercept = TRUE)
bsMat <- bSpline(x, knots = knots, intercept = TRUE)
dbsMat <- dbs(x, knots = knots, intercept = TRUE)
dbsMatNested <- deriv(deriv(ibsMat))
d2bsMat <- dbs(x, derivs = 2, knots = knots, intercept = TRUE)
d3bsMat <- dbs(x, derivs = 3, knots = knots, intercept = TRUE)
d4bsMat <- dbs(x, derivs = 4, knots = knots, intercept = TRUE)
## first derivative of ibs == bs
expect_equivalent(bsMat, tmp <- deriv(ibsMat))
## second derivative of ibs == dbs
expect_equivalent(dbsMat, deriv(bsMat))
expect_equivalent(dbsMat, deriv(ibsMat, 2))
expect_equivalent(dbsMat, tmp <- deriv(tmp))
## third derivative of ibs == d2bs
expect_equivalent(d2bsMat, deriv(dbsMat))
expect_equivalent(d2bsMat, deriv(bsMat, 2))
expect_equivalent(d2bsMat, deriv(ibsMat, 3))
expect_equivalent(d2bsMat, tmp <- deriv(tmp))
## forth derivative of ibs == d3bs
expect_equivalent(d3bsMat, deriv(d2bsMat))
expect_equivalent(d3bsMat, deriv(dbsMat, 2))
expect_equivalent(d3bsMat, deriv(bsMat, 3))
expect_equivalent(d3bsMat, deriv(ibsMat, 4))
expect_equivalent(d3bsMat, tmp <- deriv(tmp))
## fifth derivative of ibs == d4bs
expect_equivalent(d4bsMat, deriv(d3bsMat))
expect_equivalent(d4bsMat, deriv(d2bsMat, 2))
expect_equivalent(d4bsMat, deriv(dbsMat, 3))
expect_equivalent(d4bsMat, deriv(bsMat, 4))
expect_equivalent(d4bsMat, deriv(ibsMat, 5))
expect_equivalent(d4bsMat, deriv(tmp))
})
test_that("test deriv methods for M-splines related", {
## only test for scale == FALSE
csMat <- cSpline(x, knots = knots, scale = FALSE)
isMat <- iSpline(x, knots = knots)
msMat <- mSpline(x, knots = knots)
ms1Mat <- mSpline(x, knots = knots, derivs = 1)
ms2Mat <- mSpline(x, knots = knots, derivs = 2)
ms3Mat <- mSpline(x, knots = knots, derivs = 3)
ms4Mat <- mSpline(x, knots = knots, derivs = 4)
## first derivative of csMat == isMat
expect_equivalent(isMat, tmp <- deriv(csMat))
## second derivative of csMat == msMat
expect_equivalent(msMat, deriv(isMat))
expect_equivalent(msMat, deriv(csMat, 2))
expect_equivalent(msMat, tmp <- deriv(tmp))
## third derivative of csMat == ms1Mat
expect_equivalent(ms1Mat, deriv(msMat))
expect_equivalent(ms1Mat, deriv(isMat, 2))
expect_equivalent(ms1Mat, deriv(csMat, 3))
expect_equivalent(ms1Mat, tmp <- deriv(tmp))
## forth derivative of csMat == ms2Mat
expect_equivalent(ms2Mat, deriv(ms1Mat))
expect_equivalent(ms2Mat, deriv(msMat, 2))
expect_equivalent(ms2Mat, deriv(isMat, 3))
expect_equivalent(ms2Mat, deriv(csMat, 4))
expect_equivalent(ms2Mat, tmp <- deriv(tmp))
## fifth derivative of csMat == ms3Mat
expect_equivalent(ms3Mat, deriv(ms2Mat))
expect_equivalent(ms3Mat, deriv(ms1Mat, 2))
expect_equivalent(ms3Mat, deriv(msMat, 3))
expect_equivalent(ms3Mat, deriv(isMat, 4))
expect_equivalent(ms3Mat, deriv(csMat, 5))
expect_equivalent(ms3Mat, tmp <- deriv(tmp))
## sixth derivative of csMat == ms4Mat
expect_equivalent(ms4Mat, deriv(ms3Mat))
expect_equivalent(ms4Mat, deriv(ms2Mat, 2))
expect_equivalent(ms4Mat, deriv(ms1Mat, 3))
expect_equivalent(ms4Mat, deriv(msMat, 4))
expect_equivalent(ms4Mat, deriv(isMat, 5))
expect_equivalent(ms4Mat, deriv(csMat, 6))
expect_equivalent(ms4Mat, tmp <- deriv(tmp))
## simple test for scale = TRUE
csMat <- cSpline(x, knots = knots, degree = 4)
expect_equal(isNumMatrix(deriv(csMat), 12L, 7L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equivalent(deriv(csMat, 2), deriv(deriv(csMat)))
expect_equivalent(deriv(csMat, 3), deriv(deriv(csMat, 2)))
expect_equivalent(deriv(csMat, 3), deriv(deriv(deriv(csMat))))
})
splines2/tests/testthat/test-cSpline.R 0000644 0001762 0000144 00000003266 13210312372 017511 0 ustar ligges users context("Testing cSpline")
test_that("check output dimension", {
x <- seq.int(0, 10, 0.5)
knots <- c(3, NA, 5, 7, NA)
expect_equal(isNumMatrix(cSpline(x, df = 5), 21L, 5L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x, knots = knots, degree = 2),
21L, 5L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x, knots = knots), 21L, 6L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x, knots = knots, intercept = TRUE),
21L, 7L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_error(cSpline(x, degree = 0))
expect_equal(isNumMatrix(cSpline(x, degree = 0, intercept = TRUE), 21L, 1L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x, degree = 1), 21L, 1L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x, degree = 1, intercept = TRUE), 21L, 2L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x, degree = 2), 21L, 2L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x, degree = 2, intercept = TRUE), 21L, 3L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x), 21L, 3L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(cSpline(x, intercept = TRUE), 21L, 4L,
warn_na = FALSE, error_na = FALSE), TRUE)
})
splines2/tests/testthat/test-dbs.R 0000644 0001762 0000144 00000006477 13210312372 016673 0 ustar ligges users context("Testing dbs with splines::splineDesign")
test_that("cubic B-splines without internal knots", {
x <- seq.int(0, 1, 0.05)
ord <- 4
aKnots <- c(rep(0, ord), rep(1, ord))
expect_equivalent(dbs(x, derivs = 1, intercept = TRUE),
splines::splineDesign(aKnots, x = x, derivs = 1))
expect_equivalent(dbs(x, derivs = 2, intercept = TRUE),
splines::splineDesign(aKnots, x = x, derivs = 2))
expect_equivalent(dbs(x, derivs = 3, intercept = TRUE),
splines::splineDesign(aKnots, x = x, derivs = 3))
})
test_that("cubic B-splines with three internal knots", {
x <- seq.int(0, 1, 0.05)
knots <- c(0.2, NA, 0.4, 0.7, NA)
ord <- 4
aKnots <- c(rep(0, ord), na.omit(knots), rep(1, ord))
expect_equivalent(dbs(x, derivs = 1, knots = knots, intercept = TRUE),
splines::splineDesign(aKnots, x = x, derivs = 1))
expect_equivalent(dbs(x, derivs = 2, knots = knots, intercept = TRUE),
splines::splineDesign(aKnots, x = x, derivs = 2))
expect_equivalent(dbs(x, derivs = 3, knots = knots, intercept = TRUE),
splines::splineDesign(aKnots, x = x, derivs = 3))
})
test_that("quad B-splines with two internal knots", {
x <- seq.int(0, 1, 0.05)
knots <- c(0.3, NA, 0.6)
ord <- 5
aKnots <- c(rep(0, ord), na.omit(knots), rep(1, ord))
expect_equivalent(dbs(x, 1, knots = knots, degree = 4, intercept = TRUE),
splines::splineDesign(aKnots, x, ord, derivs = 1))
expect_equivalent(dbs(x, 2, knots = knots, degree = 4, intercept = TRUE),
splines::splineDesign(aKnots, x, ord, derivs = 2))
expect_equivalent(dbs(x, 3, knots = knots, degree = 4, intercept = TRUE),
splines::splineDesign(aKnots, x, ord, derivs = 3))
expect_equivalent(dbs(x, 4, knots = knots, degree = 4, intercept = TRUE),
splines::splineDesign(aKnots, x, ord, derivs = 4))
})
test_that("B-splines derivatives with df given", {
x <- seq.int(0, 1, 0.05)
expect_warning(dbs(x, 1, df = 0, intercept = TRUE))
expect_warning(dbs(x, 1, df = 1, intercept = TRUE))
expect_warning(dbs(x, 1, df = 2, intercept = TRUE))
expect_warning(dbs(x, 1, df = 3, intercept = TRUE))
expect_warning(dbs(x, 2, df = 3, intercept = TRUE))
expect_equal(isNumMatrix(dbs(x, 1, df = 1, degree = 0, intercept = TRUE),
21L, 1L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(dbs(x, 1, df = 4), 21L, 4L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(dbs(x, 1, df = 4, intercept = TRUE),
21L, 4L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(dbs(x, 1, df = 5),
21L, 5L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(dbs(x, 1, df = 5, intercept = TRUE),
21L, 5L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(dbs(x, 1, df = 5, degree = 0),
21L, 5L, warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(dbs(x, 1, df = 5, degree = 0, intercept = TRUE),
21L, 5L, warn_na = FALSE, error_na = FALSE), TRUE)
})
splines2/tests/testthat/test-print.R 0000644 0001762 0000144 00000000773 13155556756 017300 0 ustar ligges users context("Testing print methods")
test_that("print methods", {
x <- c(NA, seq.int(0, 10, 0.5), NA)
bsMat <- bSpline(x)
ibsMat <- ibs(x)
dbsMat <- dbs(x)
msMat <- mSpline(x)
isMat <- iSpline(x)
csMat <- cSpline(x)
expect_equivalent(print(bsMat), bsMat)
expect_equivalent(print(ibsMat), ibsMat)
expect_equivalent(print(dbsMat), dbsMat)
expect_equivalent(print(msMat), msMat)
expect_equivalent(print(isMat), isMat)
expect_equivalent(print(csMat), csMat)
})
splines2/tests/testthat/test-mSpline.R 0000644 0001762 0000144 00000006675 13210312372 017532 0 ustar ligges users context("Testing mSpline")
test_that("check outputs", {
x <- c(NA, seq.int(0, 0.5, 0.1), NA, seq.int(0.6, 1, 0.1), NA)
knots <- c(0.25, 0.5, 0.75)
## for testing splines with degree zero
msMat0a <- mSpline(x, degree = 0, intercept = TRUE)
msMat0b <- mSpline(x, knots = knots, degree = 1)
msMat0c <- mSpline(x, knots = knots, degree = 1, intercept = TRUE)
msMat0d <- mSpline(x, knots = knots, degree = 2)
msMat0e <- mSpline(x, knots = knots, degree = 2, intercept = TRUE)
msMat0f <- mSpline(0.1, knots = knots, degree = 2, intercept = TRUE,
Boundary.knots = c(0, 1), derivs = 1)
msMat0g <- mSpline(0.1, knots = knots, degree = 2, intercept = TRUE,
Boundary.knots = c(0, 1), derivs = 2)
msMat0h <- mSpline(0.1, knots = knots, degree = 2,
Boundary.knots = c(0, 1), derivs = 3)
expect_equal(isNumMatrix(msMat0a, 14L, 1L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(sum(is.na(msMat0b)), 12L) # keep NA's as is
expect_equal(isNumMatrix(msMat0b, 14L, 4L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(msMat0c, 14L, 5L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(msMat0d, 14L, 5L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(msMat0e, 14L, 6L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(msMat0f, 1L, 6L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(msMat0g, 1L, 6L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_equal(isNumMatrix(msMat0h, 1L, 5L,
warn_na = FALSE, error_na = FALSE), TRUE)
expect_error(mSpline(x, degree = 0),
"'intercept' has to be 'TRUE'", fixed = TRUE)
expect_warning(mSpline(x, df = 1, knots = 0.5, degree = 0),
"'df' specified was not appropriate.", fixed = TRUE)
expect_warning(mSpline(x, df = 3, knots = 0.5, degree = 0),
"'df' specified was not appropriate.", fixed = TRUE)
expect_warning(mSpline(c(x, 10), knots = knots, degree = 0,
Boundary.knots = c(0, 1)),
"beyond boundary knots", fixed = TRUE)
})
## true close form formula given the all knots and degree
test_that("transformation of constant bases", {
x <- seq.int(0, 7, 0.1)
knots <- c(1, 3)
m0_1 <- function(x) as.numeric(x < 1)
m0_2 <- function(x) as.numeric(x >= 1 & x < 3) * 0.5
m0_3 <- function(x) as.numeric(x >= 3 & x < 7) * 0.25
expect_equivalent(mSpline(x, knots = knots, degree = 0L, intercept = TRUE),
cbind(m0_1(x), m0_2(x), m0_3(x)))
})
test_that("transformation of linear bases", {
x <- seq.int(0, 3, 0.1)
knots <- c(1, 2)
ind01 <- function(x) as.numeric(x >= 0 & x < 1)
ind12 <- function(x) as.numeric(x >= 1 & x < 2)
ind23 <- function(x) as.numeric(x >= 2 & x <= 3)
m0_1 <- function(x) ind01(x) * (2 - 2 * x)
m0_2 <- function(x) ind01(x) * x + ind12(x) * (2 - x)
m0_3 <- function(x) ind12(x) * (x - 1) + ind23(x) * (3 - x)
m0_4 <- function(x) ind23(x) * (2 * x - 4)
expect_equivalent(mSpline(x, knots = knots, degree = 1L, intercept = TRUE),
cbind(m0_1(x), m0_2(x), m0_3(x), m0_4(x)))
})
splines2/tests/testthat/test-ibs.R 0000644 0001762 0000144 00000004612 13155556756 016715 0 ustar ligges users context("Testing ibs")
test_that("without internal knots", {
x <- seq.int(0, 1, 0.1)
## degree = 0
expect_equivalent(matrix(x), ibs(x, degree = 0, intercept = TRUE))
## degree = 1
b1 <- function(x) x - x ^ 2 / 2
b2 <- function(x) x ^ 2 / 2
i1mat <- cbind(b1(x), b2(x))
expect_equivalent(matrix(b2(x)), ibs(x, degree = 1))
expect_equivalent(i1mat, ibs(x, degree = 1, intercept = TRUE))
## degree = 2
b1 <- function(x) x ^ 3 / 3 - x ^ 2 + x
b2 <- function(x) - 2 * x ^ 3 / 3 + x ^ 2
b3 <- function(x) x ^ 3 / 3
i2mat <- cbind(b1(x), b2(x), b3(x))
expect_equivalent(cbind(b2(x), b3(x)), ibs(x, degree = 2))
expect_equivalent(i2mat, ibs(x, degree = 2, intercept = TRUE))
## degree = 3
b1 <- function(x) - (1 - x) ^ 4 / 4 + 1 / 4
b2 <- function(x) 3 / 4 * x ^ 4 - 2 * x ^ 3 + 3 / 2 * x ^ 2
b3 <- function(x) x ^ 3 - 3 / 4 * x ^ 4
b4 <- function(x) x ^ 4 / 4
i3mat <- cbind(b1(x), b2(x), b3(x), b4(x))
expect_equivalent(cbind(b2(x), b3(x), b4(x)), ibs(x, degree = 3))
expect_equivalent(i3mat, ibs(x, degree = 3, intercept = TRUE))
})
test_that("with two internal knots", {
x <- seq.int(0, 4, 0.1)
knots <- c(NA, 1, NA, 3, NA)
ind01 <- function(x) as.numeric(x >= 0 & x < 1)
ind13 <- function(x) as.numeric(x >= 1 & x < 3)
ind34 <- function(x) as.numeric(x >= 3 & x <= 4)
## degree = 0
b1 <- function(x) ind01(x) * x + ind13(x) + ind34(x)
b2 <- function(x) ind13(x) * (x - 1) + 2 * ind34(x)
b3 <- function(x) ind34(x) * (x - 3)
expect_equivalent(cbind(b2(x), b3(x)),
ibs(x, knots = knots, degree = 0))
expect_equivalent(cbind(b1(x), b2(x), b3(x)),
ibs(x, knots = knots, degree = 0, intercept = TRUE))
## degree = 1
b1 <- function(x) ind01(x) * (x - x ^ 2 / 2) + (ind13(x) + ind34(x)) / 2
b2 <- function(x) {
ind01(x) * x ^ 2 / 2 +
ind13(x) * (1.5 * x - 0.25 * x ^ 2 - 3 / 4) + ind34(x) * 1.5
}
b3 <- function(x) {
ind13(x) * (x ^ 2 / 4 - x / 2 + 1 / 4) +
ind34(x) * (- x ^ 2 / 2 + 4 * x - 6.5)
}
b4 <- function(x) ind34(x) * (x ^ 2 / 2 - 3 * x + 4.5)
expect_equivalent(cbind(b2(x), b3(x), b4(x)),
ibs(x, knots = knots, degree = 1))
expect_equivalent(cbind(b1(x), b2(x), b3(x), b4(x)),
ibs(x, knots = knots, degree = 1, intercept = TRUE))
})
splines2/tests/testthat/test-predict.R 0000644 0001762 0000144 00000001221 13155556756 017563 0 ustar ligges users context("Testing predict methods")
test_that("predict methods", {
x <- c(seq.int(0, 10, 0.5), NA)
bsMat <- bSpline(x)
ibsMat <- ibs(x)
dbsMat <- dbs(x)
msMat <- mSpline(x)
isMat <- iSpline(x)
csMat <- cSpline(x)
expect_equivalent(predict(bsMat, 1), bsMat[3L, , drop = FALSE])
expect_equivalent(predict(ibsMat, 1), ibsMat[3L, , drop = FALSE])
expect_equivalent(predict(dbsMat, 1), dbsMat[3L, , drop = FALSE])
expect_equivalent(predict(msMat, 1), msMat[3L, , drop = FALSE])
expect_equivalent(predict(isMat, 1), isMat[3L, , drop = FALSE])
expect_equivalent(predict(csMat, 1), csMat[3L, , drop = FALSE])
})
splines2/NAMESPACE 0000644 0001762 0000144 00000001253 13155556756 013253 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(deriv,bSpline2)
S3method(deriv,cSpline)
S3method(deriv,dbs)
S3method(deriv,iSpline)
S3method(deriv,ibs)
S3method(deriv,mSpline)
S3method(predict,bSpline2)
S3method(predict,cSpline)
S3method(predict,dbs)
S3method(predict,iSpline)
S3method(predict,ibs)
S3method(predict,mSpline)
S3method(print,bSpline2)
S3method(print,cSpline)
S3method(print,dbs)
S3method(print,iSpline)
S3method(print,ibs)
S3method(print,mSpline)
export(bSpline)
export(cSpline)
export(dbs)
export(iSpline)
export(ibs)
export(mSpline)
importFrom(splines,bs)
importFrom(stats,deriv)
importFrom(stats,predict)
importFrom(stats,quantile)
importFrom(stats,stepfun)
splines2/NEWS.md 0000644 0001762 0000144 00000004752 13310532342 013113 0 ustar ligges users # splines2 0.2.8
## Bug fixes
* Fixed inconsistency of argument `df` for piece-wise constant bases when
`knots = NULL`.
# splines2 0.2.7
## Minor changes
* Updated tests for R development version.
# splines2 0.2.6
## Minor changes
* Added checks for any internal knot incorrectly placed outside of the boundary
knots and added warnings for users' reference.
# splines2 0.2.5
## Minor changes
* Added more tests and increased code coverage.
## Bug fixes
* Fixed evaluation of derivatives of M-splines for a single value. Thanks Ina
Jazic for reporting the bug and providing possible fix.
* Fixed `deriv.cSpline` method for derivatives of order greater than two when
`scale = TRUE`.
# splines2 0.2.4
## New features
* Added function `dbs` generating derivative of given order of B-splines. It is
a similar function with `splines::splineDesign`. However, it provides a more
user-friendly interface and more consistent handling on `NA`'s.
* Added `deriv` methods for derivatives of given order of any existing
**splines2** object that can be generated currently.
## Major changes
* Added argument `derivs` to function `mSpline` and `iSpline` for derivatives.
* Changed all the classes of object generated for a better dispatching on
methods.
## Minor changes
* Added tests for all major functions with the help of package **testthat**.
## Bug fixes
* Fixed the generation of splines without any internal knot.
# splines2 0.2.3
## Bug fixes
* Fixed one-piece constant basis for M-splines.
# splines2 0.2.2
## Bug fixes
* Fixed the NA's handling in all the functions constructing spline bases.
# splines2 0.2.1
## New features
* Added function `bSpline` generating B-spline basis allowing zero degree or
piecewise constant basis based on function `bs` in package **splines**.
* Introduced function `bSpline` to allow M-splines of degree zero.
* Added function `cSpline` constructing convex spline (C-spline) basis.
* Added `predict` methods for `bSpline2` object and `cSpline` object generated
by `bSpline` and `cSpline`, respectively.
* Added `print` methods for all **splines2** objects developed so far.
## Major changes
* Improved the function `iSpline` to construct I-spline basis directly from
B-spline basis instead of M-spline basis.
## Minor changes
* Updated all CRAN URL to a canonical form suggested.
# splines2 0.1.0
## New features
* The first version of **splines2** providing functions constructing M-spline,
I-spline, and integral of B-spline basis.
splines2/R/ 0000755 0001762 0000144 00000000000 13310532500 012202 5 ustar ligges users splines2/R/cSpline.R 0000644 0001762 0000144 00000021410 13310532500 013720 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' C-Spline Basis for Polynomial Splines
##'
##' This function generates the convex regression spline (called C-spline) basis
##' matrix by integrating I-spline basis for a polynomial spline.
##'
##' It is an implementation of the close form C-spline basis derived from
##' the recursion formula of I-spline and M-spline. Internally, it calls
##' \code{\link{iSpline}} and generates a basis matrix for representing the
##' family of piecewise polynomials and their corresponding integrals with the
##' specified interior knots and degree, evaluated at the values of \code{x}.
##'
##' @usage
##' cSpline(x, df = NULL, knots = NULL, degree = 3L, intercept = FALSE,
##' Boundary.knots = range(x, na.rm = TRUE), scale = TRUE, ...)
##'
##' @param x The predictor variable. Missing values are allowed and will be
##' returned as they were.
##' @param df Degrees of freedom. One can specify \code{df} rather than
##' \code{knots}, then the function chooses "df - degree" (minus one if
##' there is an intercept) knots at suitable quantiles of \code{x} (which
##' will ignore missing values). The default, \code{NULL}, corresponds to
##' no inner knots, i.e., "degree - intercept".
##' @param knots The internal breakpoints that define the spline. The default
##' is \code{NULL}, which results in a basis for ordinary polynomial
##' regression. Typical values are the mean or median for one knot,
##' quantiles for more knots. See also \code{Boundary.knots}.
##' @param degree Non-negative integer degree of the piecewise polynomial. The
##' default value is 3 for cubic splines.
##' @param intercept If \code{TRUE}, an intercept is included in the basis;
##' Default is \code{FALSE}.
##' @param Boundary.knots Boundary points at which to anchor the C-spline basis.
##' By default, they are the range of the non-\code{NA} data. If both
##' \code{knots} and \code{Boundary.knots} are supplied, the basis
##' parameters do not depend on \code{x}. Data can extend beyond
##' \code{Boundary.knots}.
##' @param scale Logical value (\code{TRUE} by default) indicating whether
##' scaling on C-spline basis is required. If TRUE, C-spline basis is scaled
##' to have unit height at right boundary knot; the corresponding I-spline
##' and M-spline basis matrices shipped in attributes are also scaled to the
##' same extent.
##' @param ... Optional arguments for future usage.
##'
##' @return A matrix of dimension \code{length(x)} by
##' \code{df = degree + length(knots)} (plus on if intercept is included).
##' The attributes that correspond to the arguments specified are returned
##' for the usage of other functions in this package.
##' @references
##' Meyer, M. C. (2008). Inference using shape-restricted regression splines.
##' \emph{The Annals of Applied Statistics}, 1013--1033. Chicago
##' @examples
##' library(splines2)
##' x <- seq.int(0, 1, 0.01)
##' knots <- c(0.3, 0.5, 0.6)
##'
##' ### when 'scale = TRUE' (by default)
##' csMat <- cSpline(x, knots = knots, degree = 2, intercept = TRUE)
##'
##' library(graphics)
##' matplot(x, csMat, type = "l", ylab = "C-spline basis")
##' abline(v = knots, lty = 2, col = "gray")
##' isMat <- deriv(csMat)
##' msMat <- deriv(csMat, derivs = 2)
##' matplot(x, isMat, type = "l", ylab = "scaled I-spline basis")
##' matplot(x, msMat, type = "l", ylab = "scaled M-spline basis")
##'
##' ### when 'scale = FALSE'
##' csMat <- cSpline(x, knots = knots, degree = 2,
##' intercept = TRUE, scale = FALSE)
##' ## the corresponding I-splines and M-splines (with same arguments)
##' isMat <- iSpline(x, knots = knots, degree = 2, intercept = TRUE)
##' msMat <- mSpline(x, knots = knots, degree = 2, intercept = TRUE)
##' ## or using deriv methods (much more efficient)
##' isMat1 <- deriv(csMat)
##' msMat1 <- deriv(csMat, derivs = 2)
##' ## equivalent
##' stopifnot(all.equal(isMat, isMat1, check.attributes = FALSE))
##' stopifnot(all.equal(msMat, msMat1, check.attributes = FALSE))
##' @seealso
##' \code{\link{predict.cSpline}} for evaluation at given (new) values;
##' \code{\link{deriv.cSpline}} for derivatives;
##' \code{\link{iSpline}} for I-splines;
##' \code{\link{mSpline}} for M-splines.
##' @importFrom stats stepfun
##' @export
cSpline <- function(x, df = NULL, knots = NULL, degree = 3L, intercept = FALSE,
Boundary.knots = range(x, na.rm = TRUE), scale = TRUE, ...)
{
## I-spline basis for inputs
isOut <- iSpline(x = x, df = df, knots = knots, degree = degree,
intercept = intercept, Boundary.knots = Boundary.knots)
## update input
degree <- attr(isOut, "degree")
knots <- attr(isOut, "knots")
bKnots <- attr(isOut, "Boundary.knots")
ord <- 1L + degree
nKnots <- length(knots)
df <- nKnots + ord
## take care of possible NA's in `x` for the following calculation
nax <- is.na(x)
if ((nas <- any(nax)))
x <- x[! nax]
nX <- length(x)
## define knot sequence
aKnots <- sort(c(rep(bKnots, ord + 1L), knots))
## generate I-spline basis with (degree + 1)
augX <- c(x, bKnots[2L])
isOut1 <- iSpline(x = augX, knots = knots, degree = ord,
intercept = FALSE, Boundary.knots = bKnots)
## function determining j from x
j <- if (length(knots)) {
foo <- stats::stepfun(x = knots, y = seq.int(ord, df))
as.integer(foo(augX))
} else {
rep.int(ord, nX + 1L)
}
numer1 <- diff(aKnots, lag = ord + 1L)[- 1L]
## if there is at least one internal knot
if (nKnots) {
## calculate C-spline basis at each internal knot t_j
isOutKnots <- iSpline(knots, knots = knots, degree = ord,
intercept = FALSE, Boundary.knots = bKnots)
matKnots <- rep(numer1, each = nKnots) * isOutKnots / (ord + 1)
augKnots <- seq_len(nKnots) + ord
diffKnots <- diff(knots)
csKnots <- lapply(seq_len(nKnots), function(i, idx) {
ji <- augKnots[i]
a <- matKnots[i, ]
js <- seq_len(ji)
a[- js] <- 0
a[js] <- rev(cumsum(rev(a[js])))
a[idx < ji - ord] <- diffKnots[ji - ord - 1L]
a
}, idx = seq_len(df))
csKnots <- do.call(rbind, csKnots)
idxMat <- lower.tri(csKnots, diag = TRUE)
linList <- lapply(seq_len(nKnots), function(ind) {
cumsum(csKnots[idxMat[, ind], ind])
})
csKnots[idxMat] <- do.call(c, linList)
} else {
csKnots <- matrix(0, 1L, df)
}
## calculate C-spline basis at each x
matX <- rep(numer1, each = nX + 1) * isOut1 / (ord + 1)
csOut <- lapply(seq_len(nX + 1L), function(i, idx) {
ji <- j[i]
xx <- augX[i]
a <- matX[i, ]
js <- seq_len(ji)
a[- js] <- 0
a[js] <- rev(cumsum(rev(a[js])))
a[idx < ji - ord] <- xx - knots[ji - ord] +
csKnots[ji - ord, idx < ji - ord]
a
}, idx = seq_len(df))
csOut <- do.call(rbind, csOut)
if (! intercept)
csOut <- csOut[, - 1L, drop = FALSE]
scl <- unname(csOut[nX + 1L, ])
csOut <- csOut[- (nX + 1L), ]
## mSpline basis matrix
msMat <- attr(isOut, "msMat")
## keep NA's as is for csOut
if (nas) {
nmat <- matrix(NA, length(nax), ncol(csOut))
nmat[! nax, ] <- csOut
csOut <- nmat
}
## scale C-spline, I-spline, and M-spline basis
if (scale) {
vec <- rep(1 / scl, each = length(nax))
csOut <- vec * csOut
isOut <- vec * isOut
msMat <- vec * msMat
attr(isOut, "scale") <- attr(msMat, "scale") <- scale
attr(isOut, "scales") <- attr(msMat, "scales") <- scl
}
## output
attr(isOut, "msMat") <- NULL
attributes(csOut) <- c(attributes(isOut),
list(isMat = isOut, msMat = msMat,
scale = scale, scales = scl))
attr(csOut, "derivs") <- NULL
class(csOut) <- c("matrix", "cSpline")
csOut
}
splines2/R/splines2-package.R 0000644 0001762 0000144 00000002712 13310532500 015457 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' splines2: Regression Spline Functions and Classes
##'
##' A supplementary package on splines providing functions constructing
##' B-splines, integral of B-splines, monotone splines (M-splines) and its
##' integral (I-splines), convex splines (C-splines), and their derivatives of
##' given order. Piecewise constant basis is allowed for B-spline and M-spline
##' basis.
##'
##' It is named after the package \pkg{splines}: ``Regression Spline Functions
##' and Classes''. The tailing number two is simply ``too'' (and by no means for
##' the generation two).
##'
##' @docType package
##' @name splines2
NULL
splines2/R/predict.R 0000644 0001762 0000144 00000011343 13310532500 013761 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' Evaluate a Spline Basis
##'
##' This function evaluates a predefined spline basis at (new) given values.
##'
##' These are methods for the generic function \code{predict} for objects
##' inheriting from class \code{bSpline2}, \code{ibs}, \code{mSpline},
##' \code{iSpline}, or \code{cSpline}. If \code{newx} is not given, the
##' function returns the input object. For object returned by function
##' \code{\link{cSpline}}, the \code{mSpline} and \code{iSpline} objects shipped
##' in attributes should not be evaluated by this function if \code{rescale} is
##' \code{TRUE}. See \code{\link{cSpline}} for details.
##'
##' @name predict
##' @param object Objects of class \code{bSpline2}, \code{ibs}, \code{mSpline},
##' \code{iSpline}, or \code{cSpline} having attributes describing
##' \code{knots}, \code{degree}, etc.
##' @param newx The \code{x} values at which evaluations are required.
##' @param ... Optional argument for future usage.
##'
##' @return An object just like the \code{object} input, except evaluated at
##' the new values of \code{x}.
##'
##' @examples
##' library(splines2)
##' x <- seq.int(0, 1, 0.2)
##' knots <- c(0.3, 0.5, 0.6)
##' newX <- seq.int(0.1, 0.9, 0.2)
##'
##' ## for B-splines
##' bsMat <- bSpline(x, knots = knots, degree = 2)
##' predict(bsMat, newX)
##'
##' ## for integral of B-splines
##' ibsMat <- ibs(x, knots = knots, degree = 2)
##' predict(ibsMat, newX)
##'
##' ## for derivative of B-splines
##' dbsMat <- dbs(x, knots = knots, degree = 2)
##' predict(dbsMat, newX)
##'
##' ## for M-spline
##' msMat <- mSpline(x, knots = knots, degree = 2)
##' predict(msMat, newX)
##'
##' ## for I-spline
##' isMat <- iSpline(x, knots = knots, degree = 2)
##' predict(isMat, newX)
##'
##' ## for C-spline
##' csMat <- cSpline(x, knots = knots, degree = 2)
##' predict(csMat, newX)
##' @seealso
##' \code{\link{bSpline}} for B-splines;
##' \code{\link{ibs}} for integral of B-splines;
##' \code{\link{dbs}} for derivative of B-splines;
##' \code{\link{mSpline}} for M-splines;
##' \code{\link{iSpline}} for I-splines;
##' \code{\link{cSpline}} for C-splines.
##' @importFrom stats predict
NULL
##' @rdname predict
##' @export
predict.bSpline2 <- function(object, newx, ...)
{
if (missing(newx))
return(object)
a <- c(list(x = newx),
attributes(object)[c("degree", "knots", "Boundary.knots",
"intercept")])
do.call("bSpline", a)
}
##' @rdname predict
##' @export
predict.ibs <- function(object, newx, ...)
{
if (missing(newx))
return(object)
a <- c(list(x = newx),
attributes(object)[c("degree", "knots", "Boundary.knots",
"intercept")])
do.call("ibs", a)
}
##' @rdname predict
##' @export
predict.dbs <- function(object, newx, ...)
{
if (missing(newx))
return(object)
a <- c(list(x = newx),
attributes(object)[c("degree", "knots", "Boundary.knots",
"intercept", "derivs")])
do.call("dbs", a)
}
##' @rdname predict
##' @export
predict.mSpline <- function(object, newx, ...)
{
if (missing(newx))
return(object)
a <- c(list(x = newx),
attributes(object)[c("degree", "knots", "Boundary.knots",
"intercept", "derivs")])
do.call("mSpline", a)
}
##' @rdname predict
##' @export
predict.iSpline <- function(object, newx, ...)
{
if (missing(newx))
return(object)
a <- c(list(x = newx),
attributes(object)[c("degree", "knots", "Boundary.knots",
"intercept", "derivs")])
do.call("iSpline", a)
}
##' @rdname predict
##' @export
predict.cSpline <- function(object, newx, ...)
{
if (missing(newx))
return(object)
a <- c(list(x = newx),
attributes(object)[c("degree", "knots", "Boundary.knots",
"intercept", "scale")])
do.call("cSpline", a)
}
splines2/R/iSpline.R 0000644 0001762 0000144 00000017504 13310532500 013737 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' I-Spline Basis for Polynomial Splines or its derivatives
##'
##' This function generates the I-spline (integral of M-spline) basis matrix for
##' a polynomial spline or its derivatives of given order..
##'
##' It is an implementation of the close form I-spline basis based on the
##' recursion formula of B-spline basis. Internally, it calls
##' \code{\link{mSpline}} and \code{\link{bSpline}}, and generates a basis
##' matrix for representing the family of piecewise polynomials and their
##' corresponding integrals with the specified interior knots and degree,
##' evaluated at the values of \code{x}.
##'
##' @usage
##' iSpline(x, df = NULL, knots = NULL, degree = 3L, intercept = FALSE,
##' Boundary.knots = range(x, na.rm = TRUE), derivs = 0L, ...)
##'
##' @param x The predictor variable. Missing values are allowed and will be
##' returned as they were.
##' @param df Degrees of freedom. One can specify \code{df} rather than
##' \code{knots}, then the function chooses "df - degree" (minus one if
##' there is an intercept) knots at suitable quantiles of \code{x} (which
##' will ignore missing values). The default, \code{NULL}, corresponds to
##' no inner knots, i.e., "degree - intercept".
##' @param knots The internal breakpoints that define the spline. The default
##' is \code{NULL}, which results in a basis for ordinary polynomial
##' regression. Typical values are the mean or median for one knot,
##' quantiles for more knots. See also \code{Boundary.knots}.
##' @param degree Non-negative integer degree of the piecewise polynomial. The
##' default value is 3 for cubic splines. Note that the degree of I-spline
##' is defined to be the degree of the associated M-spline instead of actual
##' polynomial degree. In other words, I-spline basis of degree 2 is defined
##' as the integral of associated M-spline basis of degree 2.
##' @param intercept If \code{TRUE}, an intercept is included in the basis;
##' Default is \code{FALSE}.
##' @param Boundary.knots Boundary points at which to anchor the I-spline basis.
##' By default, they are the range of the non-\code{NA} data. If both
##' \code{knots} and \code{Boundary.knots} are supplied, the basis
##' parameters do not depend on \code{x}. Data can extend beyond
##' \code{Boundary.knots}.
##' @param derivs A non-negative integer specifying the order of derivatives of
##' I-splines.
##' @param ... Optional arguments for future usage.
##'
##' @return A matrix of dimension \code{length(x)} by
##' \code{df = degree + length(knots)} (plus on if intercept is included).
##' Attributes that correspond to the arguments specified are returned
##' for usage of other functions in this package.
##' @references
##' Ramsay, J. O. (1988). Monotone regression splines in action.
##' \emph{Statistical science}, 3(4), 425--441.
##' @examples
##' ## Example given in the reference paper by Ramsay (1988)
##' library(splines2)
##' x <- seq.int(0, 1, by = 0.01)
##' knots <- c(0.3, 0.5, 0.6)
##' isMat <- iSpline(x, knots = knots, degree = 2, intercept = TRUE)
##'
##' library(graphics)
##' matplot(x, isMat, type = "l", ylab = "I-spline basis")
##' abline(v = knots, lty = 2, col = "gray")
##'
##' ## the derivative of I-splines is M-spline
##' msMat1 <- iSpline(x, knots = knots, degree = 2, derivs = 1)
##' msMat2 <- mSpline(x, knots = knots, degree = 2)
##' stopifnot(all.equal(msMat1, msMat2))
##' @seealso
##' \code{\link{predict.iSpline}} for evaluation at given (new) values;
##' \code{\link{deriv.iSpline}} for derivative method;
##' \code{\link{mSpline}} for M-splines;
##' \code{\link{cSpline}} for C-splines;
##' @importFrom stats stepfun
##' @export
iSpline <- function(x, df = NULL, knots = NULL, degree = 3L, intercept = FALSE,
Boundary.knots = range(x, na.rm = TRUE), derivs = 0L, ...)
{
## check order of derivative
if (! missing(derivs)) {
derivs <- as.integer(derivs)
if (derivs < 0L)
stop("'derivs' has to be a non-negative integer.")
}
## M-spline basis for outputs in attributes
msOut <- mSpline(x = x, df = df, knots = knots,
degree = degree, intercept = intercept,
Boundary.knots = Boundary.knots, derivs = 0L, ...)
## update input
degree <- attr(msOut, "degree")
knots <- attr(msOut, "knots")
bKnots <- attr(msOut, "Boundary.knots")
ord <- 1L + degree
nKnots <- length(knots)
df <- nKnots + ord
## default, for derivs == 0L, return I-splines
if (! derivs) {
## define knot sequence
aKnots <- sort(c(rep(bKnots, ord + 1L), knots))
## take care of possible NA's in `x` for the following calculation
nax <- is.na(x)
if (nas <- any(nax))
x <- x[! nax]
## function determining j from x
j <- if (nKnots) {
foo <- stats::stepfun(x = knots, y = seq.int(ord, df))
as.integer(foo(x))
} else {
rep.int(ord, length(x))
}
## calculate I-spline basis at non-NA x's
## directly based on B-spline
bsOut1 <- bSpline(x = x, knots = knots, degree = ord,
intercept = FALSE, Boundary.knots = bKnots)
isOut <- lapply(seq_along(j), function(i, idx) {
a <- bsOut1[i, ]
js <- seq_len(j[i])
a[- js] <- 0
a[js] <- rev(cumsum(rev(a[js])))
a[idx < j[i] - ord] <- 1 # <=> a[idx < j[i] - degree] <- 1
a
}, idx = seq_len(df))
isOut <- do.call(rbind, isOut)
## Or based on M-spline
## generate M-spline basis with (degree + 1)
## msOut1 <- mSpline(x = x, knots = knots, degree = ord,
## intercept = FALSE, Boundary.knots = bKnots)
## df <- length(knots) + ord
## numer1 <- diff(aKnots, lag = ord + 1)[- 1L]
## msMat <- rep(numer1, each = length(x)) * msOut1 / (ord + 1)
## msAugMat <- cbind(j, msMat)
## isOut <- t(apply(msAugMat, 1, function(b, idx = seq_len(df)) {
## j <- b[1L]
## a <- b[- 1L]
## js <- seq_len(j)
## a[- js] <- 0
## a[js] <- rev(cumsum(rev(a[js])))
## a[idx < j - ord] <- 1 # <=> a[idx < j - degree] <- 1
## a
## }))
## intercept
if (! intercept)
isOut <- isOut[, - 1L, drop = FALSE]
## keep NA's as is
if (nas) {
nmat <- matrix(NA, length(nax), ncol(isOut))
nmat[! nax, ] <- isOut
isOut <- nmat
}
} else {
## for derivatives >= 1L
out <- mSpline(x = x, df = df, knots = knots,
degree = degree, intercept = intercept,
Boundary.knots = Boundary.knots,
derivs = derivs - 1L, ...)
return(out)
}
## output
attributes(isOut) <- c(attributes(msOut), list(msMat = msOut))
class(isOut) <- c("matrix", "iSpline")
isOut
}
splines2/R/print.R 0000644 0001762 0000144 00000004370 13310532500 013465 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' Print Out a Spline Basis Matrix
##'
##' \code{Print} methods that simply print out the spline basis matrix without
##' unnecessary attributes.
##'
##' @name print
##' @param x Objects of class \code{bSpline2}, \code{ibs}, \code{mSpline},
##' \code{iSpline}, or \code{cSpline}, etc.
##' @param ... Optional argument for future usage.
##'
##' @return Object input.
NULL
##' @rdname print
##' @export
print.bSpline2 <- function(x, ...) {
print.default(tidyAttr(x, ...))
invisible(x)
}
##' @rdname print
##' @export
print.ibs <- function(x, ...) {
print.default(tidyAttr(x, ...))
invisible(x)
}
##' @rdname print
##' @export
print.dbs <- function(x, ...) {
print.default(tidyAttr(x, ...))
invisible(x)
}
##' @rdname print
##' @export
print.mSpline <- function(x, ...) {
print.default(tidyAttr(x, ...))
invisible(x)
}
##' @rdname print
##' @export
print.iSpline <- function(x, ...) {
print.default(tidyAttr(x, ...))
invisible(x)
}
##' @rdname print
##' @export
print.cSpline <- function(x, ...) {
print.default(tidyAttr(x, ...))
invisible(x)
}
### internal function ==========================================================
## remove all attributes but dim and dimnames
tidyAttr <- function(x, ...) {
dimen <- attr(x, "dim")
dimenName <- attr(x, "dimnames")
attributes(x) <- NULL
attr(x, "dim") <- dimen
attr(x, "dimnames") <- dimenName
x
}
splines2/R/bSpline.R 0000644 0001762 0000144 00000025236 13310532500 013731 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' B-Spline Basis for Polynomial Splines
##'
##' This function generates the B-spline basis matrix for a polynomial spline.
##'
##' It is an augmented function of \code{\link[splines]{bs}} in package
##' \code{splines} for B-spline basis that allows piecewise constant (close on
##' the left, open on the right) spline basis with zero degree. When the
##' argument \code{degree} is greater than zero, it internally calls
##' \code{\link[splines]{bs}} and generates a basis matrix for representing the
##' family of piecewise polynomials with the specified interior knots and
##' degree, evaluated at the values of \code{x}. The function has the same
##' arguments with \code{\link[splines]{bs}} for ease usage.
##'
##' @usage
##' bSpline(x, df = NULL, knots = NULL, degree = 3L, intercept = FALSE,
##' Boundary.knots = range(x, na.rm = TRUE), ...)
##'
##' @param x The predictor variable. Missing values are allowed and will be
##' returned as they were.
##' @param df Degrees of freedom. One can specify \code{df} rather than
##' \code{knots}, then the function chooses "df - degree" (minus one if
##' there is an intercept) knots at suitable quantiles of \code{x} (which
##' will ignore missing values). The default, \code{NULL}, corresponds to
##' no inner knots, i.e., "degree - intercept". If \code{knots} was
##' specified, \code{df} specified will be ignored.
##' @param knots The internal breakpoints that define the spline. The default
##' is \code{NULL}, which results in a basis for ordinary polynomial
##' regression. Typical values are the mean or median for one knot,
##' quantiles for more knots. See also \code{Boundary.knots}.
##' @param degree Non-negative integer degree of the piecewise polynomial. The
##' default value is 3 for cubic splines. Zero degree is allowed for this
##' function, which is the only difference compared with
##' \code{\link[splines]{bs}} in package \code{splines}.
##' @param intercept If \code{TRUE}, an intercept is included in the basis;
##' Default is \code{FALSE}.
##' @param Boundary.knots Boundary points at which to anchor the B-spline basis.
##' By default, they are the range of the non-\code{NA} data. If both
##' \code{knots} and \code{Boundary.knots} are supplied, the basis
##' parameters do not depend on \code{x}. Data can extend beyond
##' \code{Boundary.knots}.
##' @param ... Optional arguments for future usage.
##'
##' @return A matrix of dimension \code{length(x)} by
##' \code{df = degree + length(knots)} (plus one if intercept is included).
##' Attributes that correspond to the arguments specified are returned
##' for usage of other functions in this package.
##' @examples
##' library(splines2)
##' x <- seq.int(0, 1, 0.01)
##' knots <- c(0.3, 0.5, 0.6)
##' bsMat <- bSpline(x, knots = knots, degree = 0, intercept = TRUE)
##'
##' library(graphics)
##' matplot(x, bsMat, type = "l", ylab = "Piecewise constant B-spline bases")
##' abline(v = knots, lty = 2, col = "gray")
##' @seealso
##' \code{\link{predict.bSpline2}} for evaluation at given (new) values;
##' \code{\link{dbs}}, \code{\link{deriv.bSpline2}} for derivatives;
##' \code{\link{ibs}} for integral of B-splines;
##' \code{\link{mSpline}} for M-splines;
##' \code{\link{iSpline}} for I-splines;
##' \code{\link{cSpline}} for C-splines.
##' @importFrom splines bs
##' @importFrom stats stepfun
##' @export
bSpline <- function(x, df = NULL, knots = NULL, degree = 3L, intercept = FALSE,
Boundary.knots = range(x, na.rm = TRUE), ...)
{
## check and reformat 'degree'
if ((degree <- as.integer(degree)) < 0)
stop("'degree' must be a nonnegative integer.")
## sort and remove possible NA's in internal knots if exist
if (length(knots))
knots <- sort.int(knots)
## take care of possible NA's in `x`
nax <- is.na(x)
if (all(nax))
stop("The 'x' cannot be all NA's!")
## call splines::bs for non-zero degree
if (degree > 0) {
out <- splines::bs(x = x, df = df, knots = knots,
degree = degree, intercept = intercept,
Boundary.knots = Boundary.knots)
## add "x" to attributes
attr(out, "x") <- x
## throw out warning if any internal knot outside boundary.knots
knots <- attr(out, "knots")
Boundary.knots <- attr(out, "Boundary.knots")
## any internal knots placed outside of boundary knots?
outside_knots <- (knots <= Boundary.knots[1L]) |
(knots >= Boundary.knots[2L])
if (any(outside_knots))
warning(wrapMessages(
"Some internal knots were not placed",
"inside of boundary knots,",
"which may cause \nill-conditioned bases!"
))
## update classes
class(out) <- c("matrix", "bSpline2")
return(out)
}
## else degree is zero
## remove NA's in x
xx <- if (nas <- any(nax)) x[! nax] else x
## check whether any of x is outside of the boundary knots
outside_x <- rep(FALSE, length(xx))
if (! missing(Boundary.knots)) {
if (! is.numeric(Boundary.knots) || anyNA(Boundary.knots))
stop(wrapMessages(
"The 'Boundary.knots' has to be",
"numeric vector of length 2",
"with no missing value."
))
if (length(Boundary.knots) > 2) {
warning(wrapMessages(
"Only the first two values",
"in the 'Boundary.knots' were used."
))
Boundary.knots <- Boundary.knots[seq_len(2L)]
}
Boundary.knots <- sort.int(Boundary.knots)
outside_x <- (xx < Boundary.knots[1L]) | (xx > Boundary.knots[2L])
}
if (any(outside_x))
warning(wrapMessages(
"Some 'x' values beyond boundary knots",
"may cause ill-conditioned bases!"
))
## prepare inputs for piecewise constant bases
inputs <- pieceConst(x = xx[! outside_x],
df = df, knots = knots,
Boundary.knots = Boundary.knots,
intercept = intercept)
knots <- inputs$knots
## potentially, df is a bad name since df is also a function in stats
df <- inputs$df
## piecewise constant basis
augKnots <- c(Boundary.knots[1L], knots, Boundary.knots[2L])
bsMat <- sapply(seq_len(df), function (i) {
foo <- stats::stepfun(augKnots[i: (i + 1L)], c(0L, 1L, 0L))
foo(xx)
})
## close on the right boundary knot for the last constant piece?
## if (any(rightX <- xx == Boundary.knots[2L]))
## bsMat[rightX, df] <- 1
## make sure bsMat is a matrix
if (! is.matrix(bsMat))
bsMat <- matrix(bsMat, nrow = length(xx))
## include intercept or not
if (! intercept) {
bsMat <- bsMat[, - 1L, drop = FALSE]
}
## keep NA's as is
if (nas) {
nmat <- matrix(NA, length(nax), ncol(bsMat))
nmat[! nax, ] <- bsMat
bsMat <- nmat
}
## add dimnames for consistency with bs returns
row.names(bsMat) <- names(x)
colnames(bsMat) <- as.character(seq_len(df - as.integer(! intercept)))
## on attributes
tmp <- list(degree = degree,
knots = if (is.null(knots)) numeric(0L) else knots,
Boundary.knots = Boundary.knots,
intercept = intercept, x = x)
attributes(bsMat) <- c(attributes(bsMat), tmp)
class(bsMat) <- c("matrix", "bSpline2")
bsMat
}
### internal function ==========================================================
##' @importFrom stats quantile
pieceConst <- function (x, df, knots, Boundary.knots, intercept)
{
ind <- (is.null(df) + 1L) * is.null(knots) + 1L
## ind == 1: knots is not NULL;
## df0 = df = length(knots) + 1L
## ind == 2: df is not NULL, while knots is NULL;
## df := function input
## number of knots = df - as.integer(intercept) from `splines::bs`
## df0 := DF of spline bases from splines definition
## = length(knots) + 1L
## = df - as.integer(intercept) + 1L
## ind == 3: both df and knots are NULL; one-piece constant
## number of knots = 0, df0 = 1
int_intercept <- as.integer(intercept)
df0 <- switch(ind,
length(knots) + 1L,
{
int_df <- as.integer(df)
if (int_df < 1L)
stop("The spepcified `df` must be positive!",
call. = FALSE)
int_df - int_intercept + 1L
},
{
if (! intercept)
stop(wrapMessages(
"The 'intercept' has to be 'TRUE'",
"for one-piece const basis."
), call. = FALSE)
1L
})
if (ind > 1L) {
tknots <- df0 + 1L
quans <- seq.int(from = 0, to = 1,
length.out = tknots)[- c(1L, tknots)]
knots <- as.numeric(stats::quantile(x, quans))
} else {
## any internal knots placed outside of boundary knots?
outside_knots <- (knots <= Boundary.knots[1L]) |
(knots >= Boundary.knots[2L])
## remove internal knots placed outside of boundary knots
if (any(outside_knots)) {
knots <- knots[! outside_knots]
df0 <- df0 - sum(outside_knots)
warning(wrapMessages(
"Only internal knots placed inside of",
"the boundary knots were considered."
), call. = FALSE)
}
if (! is.null(df) && df != df0)
warning(wrapMessages(
"The 'df' specified was not appropriate.",
sprintf("Used 'df = %d' instead.", df0)
), call. = FALSE)
}
list(df = df0, knots = knots)
}
splines2/R/deriv.R 0000644 0001762 0000144 00000015434 13310532500 013445 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' Derivative of Splines
##'
##' \code{deriv} methods that obtain derivative of given order of B-splines,
##' M-spline, I-splines, and C-splines, etc. At knots, the derivative is defined
##' to be the right derivative. By default, the function returns the first
##' derivative. For derivatives of order greater than one, the nested call such
##' as \code{deriv(deriv(expr))} is supported but not recommended. For a better
##' performance, argument \code{derivs} should be specified instead.
##'
##' The function is designed for most of the objects generated from this
##' package. It internally extracts necessary information about the input spline
##' basis matrix from its attributes. So the function will not work if some
##' attribute is not available.
##'
##' @name deriv
##'
##' @param expr Objects of class \code{bSpline2}, \code{ibs}, \code{dbs},
##' \code{mSpline}, \code{iSpline}, or \code{cSpline}, etc.
##' @param derivs A positive integer specifying the order of derivatives. By
##' default, it is \code{1L} for the first derivative.
##' @param ... Other arguments for further usage.
##'
##' @return A matrix of dimension \code{length(x)} by
##' \code{df = degree + length(knots)} (plus one if intercept is included).
##' Attributes that correspond to the arguments specified are returned
##' for usage for other function in this package.
##' @references
##' De Boor, Carl. (1978). \emph{A practical guide to splines}.
##' Vol. 27. New York: Springer-Verlag.
##' @examples
##' library(splines2)
##' x <- c(seq.int(0, 1, 0.1), NA) # NA's will be kept.
##' knots <- c(0.3, 0.5, 0.6)
##'
##' ## integal of B-splines and the corresponding B-splines integrated
##' ibsMat <- ibs(x, knots = knots)
##' bsMat <- bSpline(x, knots = knots)
##'
##' ## the first derivative
##' d1Mat <- deriv(ibsMat)
##' stopifnot(all.equal(bsMat, d1Mat, check.attributes = FALSE))
##'
##' ## the second derivative
##' d2Mat1 <- deriv(bsMat)
##' d2Mat2 <- deriv(ibsMat, derivs = 2L)
##' ## nested calls are supported but not recommended
##' d2Mat3 <- deriv(deriv(ibsMat))
##' stopifnot(all.equal(d2Mat1, d2Mat2, d2Mat3, check.attributes = FALSE))
##'
##' ## C-splines, I-splines, M-splines and the derivatives
##' csMat <- cSpline(x, knots = knots, scale = FALSE)
##' isMat <- iSpline(x, knots = knots)
##' stopifnot(all.equal(isMat, deriv(csMat), check.attributes = FALSE))
##'
##' msMat <- mSpline(x, knots = knots)
##' stopifnot(all.equal(msMat, deriv(isMat), deriv(csMat, 2),
##' deriv(deriv(csMat)), check.attributes = FALSE))
##'
##' dmsMat <- mSpline(x, knots = knots, derivs = 1)
##' stopifnot(all.equal(dmsMat, deriv(msMat), deriv(isMat, 2),
##' deriv(deriv(isMat)), deriv(csMat, 3),
##' deriv(deriv(deriv(csMat))), check.attributes = FALSE))
##' @seealso
##' \code{\link{bSpline}} for B-splines;
##' \code{\link{ibs}} for integral of B-splines;
##' \code{\link{mSpline}} for M-splines;
##' \code{\link{iSpline}} for I-splines;
##' \code{\link{cSpline}} for C-splines.
##' @importFrom stats deriv
NULL
##' @rdname deriv
##' @export
deriv.bSpline2 <- function(expr, derivs = 1L, ...)
{
attr(expr, "derivs") <- derivs
dMat <- do.call(dbs, attributes(expr))
class(dMat) <- c("matrix", "dbs")
dMat
}
##' @rdname deriv
##' @export
deriv.dbs <- function(expr, derivs = 1L, ...)
{
attr(expr, "derivs") <- attr(expr, "derivs") + derivs
dMat <- do.call(dbs, attributes(expr))
class(dMat) <- c("matrix", "dbs")
dMat
}
##' @rdname deriv
##' @export
deriv.ibs <- function(expr, derivs = 1L, ...)
{
## quick check on derivs
derivs <- as.integer(derivs)
if (derivs < 1L)
stop("'derivs' has to be a positive integer.")
## if first derivative, take result from existing attribute
if (derivs == 1L) {
out <- attr(expr, "bsMat")
if (is.null(out))
out <- do.call(bSpline, attributes(expr))
return(out)
}
## for higher order of derivative
attr(expr, "derivs") <- derivs - 1L
dMat <- do.call(dbs, attributes(expr))
class(dMat) <- c("matrix", "dbs")
dMat
}
##' @rdname deriv
##' @export
deriv.mSpline <- function(expr, derivs = 1L, ...)
{
## call function dbs
derivs0 <- attr(expr, "derivs")
attr(expr, "derivs") <- ifelse(is.null(derivs0), derivs, derivs0 + derivs)
dMat <- do.call(mSpline, attributes(expr))
## for possible scaling of objects from deriv.cSpline
scale <- attr(expr, "scale")
scl <- attr(expr, "scales")
if (! is.null(scale) && scale) {
dMat <- dMat * rep(scl, each = nrow(dMat))
attr(dMat, "scale") <- scale
attr(dMat, "scales") <- scl
}
## prepare for output
class(dMat) <- c("matrix", "mSpline")
dMat
}
##' @rdname deriv
##' @export
deriv.iSpline <- function(expr, derivs = 1L, ...)
{
## quick check on derivs
derivs <- as.integer(derivs)
if (derivs < 1L)
stop("'derivs' has to be a positive integer.")
## extract existing result from attributes for the first derivative
if (derivs == 1L) {
dMat <- attr(expr, "msMat")
if (is.null(dMat))
dMat <- deriv.mSpline(expr, derivs = 1L, ...)
} else {
## for derivative of higher order
dMat <- deriv.mSpline(expr = expr, derivs = derivs - 1L, ...)
}
class(dMat) <- c("matrix", "mSpline")
dMat
}
##' @rdname deriv
##' @export
deriv.cSpline <- function(expr, derivs = 1L, ...)
{
derivs <- as.integer(derivs)
if (derivs < 1L)
stop("'derivs' has to be a positive integer.")
scale <- attr(expr, "scale")
scl <- attr(expr, "scales")
if (derivs == 1L) {
dMat <- attr(expr, "isMat")
attr(dMat, "msMat") <- attr(expr, "msMat")
class(dMat) <- c("matrix", "iSpline")
} else if (derivs == 2L) {
dMat <- attr(expr, "msMat")
class(dMat) <- c("matrix", "mSpline")
} else {
dMat <- deriv.mSpline(expr = expr, derivs = derivs - 2L, ...)
attr(dMat, "derivs") <- derivs - 2L
}
dMat
}
splines2/R/misc.R 0000644 0001762 0000144 00000005376 13310532500 013273 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
### some trivial internal functions ============================================
## wrap messages and keep proper line length
wrapMessages <- function(..., strwrap.args = list()) {
x <- paste(...)
wrap_x <- do.call(strwrap, c(list(x = x), strwrap.args))
paste(wrap_x, collapse = "\n")
}
## warning if x contains NA (or NaN)
na_warning <- function(x, sub_env = c("current", "parent", "grandparent"),
num_grandparent = 2L, ...)
{
sub_env <- switch(
match.arg(sub_env),
"current" = environment(),
"parent" = parent.frame(),
"grandparent" = parent.frame(num_grandparent)
)
objName = deparse(substitute(x, sub_env))
if (anyNA(x))
warning(wrapMessages(
sprintf("Found `NA` values in `%s`.", objName)
), call. = FALSE)
invisible(x)
}
## stop if x contains NA (or NaN)
na_stop <- function(x, sub_env = c("current", "parent", "grandparent"),
num_grandparent = 2L, ...)
{
sub_env <- switch(
match.arg(sub_env),
"current" = environment(),
"parent" = parent.frame(),
"grandparent" = parent.frame(num_grandparent)
)
objName = deparse(substitute(x, sub_env))
if (anyNA(x))
stop(wrapMessages(
sprintf("Found `NA` values in `%s`.", objName)
), call. = FALSE)
invisible(x)
}
## is x a numeric matrix (optionally of nRow rows and nCol columns)
isNumMatrix <- function(x, nRow = NULL, nCol = NULL,
warn_na = TRUE, error_na = ! warn_na,
sub_env = "parent", ...)
{
out <- is.numeric(x) && is.matrix(x)
if (out) {
nDim <- dim(x)
if (! is.null(nRow)) out <- out && nDim[1L] == nRow
if (! is.null(nCol)) out <- out && nDim[2L] == nCol
if (error_na) na_stop(x, sub_env = sub_env, ...)
if (warn_na) na_warning(x, sub_env = sub_env, ...)
}
out
}
splines2/R/ibs.R 0000644 0001762 0000144 00000013272 13310532500 013107 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' Integral of B-Spline Basis for Polynomial Splines
##'
##' This function generates the integral of B-spline basis matrix
##' for a polynomial spline. The arguments are exactly the same with function
##' \code{\link[splines]{bs}} in package \code{splines}.
##'
##' It is an implementation of the close form integral of B-spline basis based
##' on recursion relation. Internally, it calls \code{\link{bSpline}} and
##' generates a basis matrix for representing the family of piecewise
##' polynomials and their corresponding integrals with the specified interior
##' knots and degree, evaluated at the values of \code{x}.
##'
##' @usage
##' ibs(x, df = NULL, knots = NULL, degree = 3, intercept = FALSE,
##' Boundary.knots = range(x, na.rm = TRUE), ...)
##'
##' @param x The predictor variable. Missing values are allowed and will be
##' returned as they were.
##' @param df Degrees of freedom of the B-spline basis to be integrated. One
##' can specify \code{df} rather than \code{knots}, then the function
##' chooses "df - degree" (minus one if there is an intercept) knots at
##' suitable quantiles of \code{x} (which will ignore missing values). The
##' default, \code{NULL}, corresponds to no inner knots, i.e.,
##' "degree - intercept".
##' @param knots The internal breakpoints that define the B-spline basis to be
##' integrated. The default is \code{NULL}, which results in a basis for
##' ordinary polynomial regression. Typical values are the mean or median
##' for one knot, quantiles for more knots. See also \code{Boundary.knots}.
##' @param degree Non-negative integer degree of the piecewise polynomial to be
##' integrated. The default value is 3 for the integral of cubic B-splines.
##' @param intercept If \code{TRUE}, an intercept is included in the basis;
##' Default is \code{FALSE}.
##' @param Boundary.knots Boundary points at which to anchor the B-spline basis
##' to be integrated. By default, they are the range of the non-\code{NA}
##' data. If both \code{knots} and \code{Boundary.knots} are supplied, the
##' basis parameters do not depend on \code{x}. Data can extend beyond
##' \code{Boundary.knots}.
##' @param ... Optional arguments for future usage.
##'
##' @return A matrix of dimension \code{length(x)} by
##' \code{df = degree + length(knots)} (plus on if intercept is included).
##' Attributes that correspond to the arguments specified are returned
##' for usage of other functions in this package.
##' @references
##' De Boor, Carl. (1978). \emph{A practical guide to splines}.
##' Vol. 27. New York: Springer-Verlag.
##' @examples
##' library(splines2)
##' x <- seq.int(0, 1, 0.01)
##' knots <- c(0.2, 0.4, 0.7, 0.9)
##' ibsMat <- ibs(x, knots = knots, degree = 1, intercept = TRUE)
##'
##' ## the B-spline bases integrated by function bSpline (same arguments)
##' bsMat0 <- bSpline(x, knots = knots, degree = 1, intercept = TRUE)
##' ## or by function deriv (recommended) that directly extracts the existing
##' ## result from the attribute of ibsMat and thus is much more efficient.
##' bsMat <- deriv(ibsMat)
##' stopifnot(all.equal(bsMat0, bsMat, check.attributes = FALSE)) # equivalent
##'
##' ## plot B-spline basis with their corresponding integrals
##' library(graphics)
##' par(mfrow = c(1, 2))
##' matplot(x, bsMat, type = "l", ylab = "B-spline basis")
##' abline(v = knots, lty = 2, col = "gray")
##' matplot(x, ibsMat, type = "l", ylab = "Integral of B-spline basis")
##' abline(v = knots, lty = 2, col = "gray")
##' par(mfrow = c(1, 1))
##' @seealso
##' \code{\link{predict.ibs}} for evaluation at given (new) values;
##' \code{\link{deriv.ibs}} for derivative method.
##' \code{\link{bSpline}} for B-splines;
##' \code{\link{dbs}} for derivatives of B-splines;
##' @export
ibs <- function(x, df = NULL, knots = NULL, degree = 3, intercept = FALSE,
Boundary.knots = range(x, na.rm = TRUE), ...)
{
## B-spline basis for inputs
bsOut <- bSpline(x = x, df = df, knots = knots, degree = degree,
intercept = intercept, Boundary.knots = Boundary.knots)
## update input
degree <- attr(bsOut, "degree")
knots <- attr(bsOut, "knots")
bKnots <- attr(bsOut, "Boundary.knots")
ord <- 1L + degree
## define knot sequence
aKnots <- sort(c(rep(bKnots, ord), knots))
## generate B-spline basis with (degree + 1)
bsOut1 <- bSpline(x = x, knots = knots, degree = ord,
intercept = FALSE, Boundary.knots = bKnots)
numer1 <- diff(aKnots, lag = ord)
if (! intercept) {
bsOut1 <- bsOut1[, - 1L, drop = FALSE]
numer1 <- numer1[- 1L]
}
numer2 <- apply(bsOut1, 1, function(a) rev(cumsum(rev(a))))
ibsOut <- t(numer1 * numer2) / ord
## output
attributes(ibsOut) <- c(attributes(bsOut),
list(bsMat = bsOut, x = x))
class(ibsOut) <- c("matrix", "ibs")
ibsOut
}
splines2/R/mSpline.R 0000644 0001762 0000144 00000013430 13310532500 013735 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' M-Spline Basis for Polynomial Splines and its Derivatives
##'
##' This function generates the monotone regression spline (or simply called
##' M-spline) basis matrix for a polynomial spline or its derivatives of given
##' order.
##'
##' It is an implementation of the close form M-spline basis based on
##' relationship between M-spline basis and B-spline basis. In fact, M-spline
##' basis is a rescaled version of B-spline basis. Internally, it calls function
##' \code{\link{bSpline}} and generates a basis matrix for representing the
##' family of piecewise polynomials with the specified interior knots and
##' degree, evaluated at the values of \code{x}.
##'
##' @usage
##' mSpline(x, df = NULL, knots = NULL, degree = 3L, intercept = FALSE,
##' Boundary.knots = range(x, na.rm = TRUE), derivs = 0L, ...)
##'
##' @param x The predictor variable. Missing values are allowed and will be
##' returned as they were.
##' @param df Degrees of freedom. One can specify \code{df} rather than
##' \code{knots}, then the function chooses "df - degree" (minus one if
##' there is an intercept) knots at suitable quantiles of \code{x} (which
##' will ignore missing values). The default, \code{NULL}, corresponds to
##' no inner knots, i.e., "degree - intercept".
##' @param knots The internal breakpoints that define the spline. The default
##' is \code{NULL}, which results in a basis for ordinary polynomial
##' regression. Typical values are the mean or median for one knot,
##' quantiles for more knots. See also \code{Boundary.knots}.
##' @param degree Non-negative integer degree of the piecewise polynomial. The
##' default value is 3 for cubic splines. Zero degree is allowed for
##' piecewise constant basis.
##' @param intercept If \code{TRUE}, an intercept is included in the basis;
##' Default is \code{FALSE}.
##' @param Boundary.knots Boundary points at which to anchor the M-spline basis.
##' By default, they are the range of the non-\code{NA} data. If both
##' \code{knots} and \code{Boundary.knots} are supplied, the basis
##' parameters do not depend on \code{x}. Data can extend beyond
##' \code{Boundary.knots}.
##' @param derivs A non-negative integer specifying the order of derivatives of
##' M-splines. The default value is \code{0L} for M-spline bases.
##' @param ... Optional arguments for future usage.
##'
##' @return A matrix of dimension \code{length(x)} by
##' \code{df = degree + length(knots)} (plus one if intercept is included).
##' Attributes that correspond to the arguments specified are returned
##' for usage of other functions in this package.
##' @references
##' Ramsay, J. O. (1988). Monotone regression splines in action.
##' \emph{Statistical science}, 3(4), 425--441.
##' @examples
##' ## Example given in the reference paper by Ramsay (1988)
##' library(splines2)
##' x <- seq.int(0, 1, 0.01)
##' knots <- c(0.3, 0.5, 0.6)
##' msMat <- mSpline(x, knots = knots, degree = 2, intercept = TRUE)
##'
##' library(graphics)
##' matplot(x, msMat, type = "l", ylab = "M-spline basis")
##' abline(v = knots, lty = 2, col = "gray")
##'
##' ## derivatives of M-splines
##' dmsMat <- mSpline(x, knots = knots, degree = 2,
##' intercept = TRUE, derivs = 1)
##' ## or using the 'deriv' method
##' dmsMat1 <- deriv(msMat)
##' stopifnot(all.equal(dmsMat, dmsMat1, check.attributes = FALSE))
##' @seealso
##' \code{\link{predict.mSpline}} for evaluation at given (new) values;
##' \code{\link{deriv.mSpline}} for derivative method;
##' \code{\link{bSpline}} for B-splines;
##' \code{\link{iSpline}} for I-splines;
##' \code{\link{cSpline}} for C-splines.
##' @export
mSpline <- function(x, df = NULL, knots = NULL, degree = 3L, intercept = FALSE,
Boundary.knots = range(x, na.rm = TRUE), derivs = 0L, ...)
{
## check order of derivative
if (! missing(derivs)) {
derivs <- as.integer(derivs)
if (derivs < 0L)
stop("'derivs' has to be a non-negative integer.")
}
bsOut <- if (derivs) {
dbs(x = x, derivs = derivs, df = df, knots = knots,
degree = degree, intercept = intercept,
Boundary.knots = Boundary.knots, ...)
} else {
bSpline(x = x, df = df, knots = knots,
degree = degree, intercept = intercept,
Boundary.knots = Boundary.knots, ...)
}
## update input
ord <- attr(bsOut, "degree") + 1L
knots <- attr(bsOut, "knots")
bKnots <- attr(bsOut, "Boundary.knots")
## define knot sequence
aKnots <- sort(c(rep(bKnots, ord), knots))
## transformation from B-splines to M-splines
denom <- diff(aKnots, lag = ord)
transCoef <- ifelse(denom > 0, ord / denom, 0)
if (! intercept)
transCoef <- transCoef[- 1L]
msOut <- rep(transCoef, each = length(x)) * bsOut
attr(msOut, "derivs") <- derivs
class(msOut) <- c("matrix", "mSpline")
msOut
}
splines2/R/dbs.R 0000644 0001762 0000144 00000021061 13310532500 013075 0 ustar ligges users ################################################################################
##
## R package splines2 by Wenjie Wang and Jun Yan
## Copyright (C) 2016-2018
##
## This file is part of the R package splines2.
##
## The R package splines2 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 3 of the License, or
## any later version (at your option). See the GNU General Public License
## at for details.
##
## The R package splines2 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.
##
################################################################################
##' Derivative of B-Spline Basis for Polynomial Splines
##'
##' This function produces the derivative of given order of B-splines. It is an
##' implementation of the close form derivative of B-spline basis based on
##' recursion relation. At knots, the derivative is defined to be the right
##' derivative.
##'
##' The function is similar with \code{\link[splines]{splineDesign}}. However,
##' it provides a more user-friendly interface, a more considerate \code{NA}'s
##' handling. Internally, it calls \code{\link{bSpline}} and generates a basis
##' matrix for representing the family of piecewise polynomials and their
##' corresponding derivative with the specified interior knots and degree,
##' evaluated at the values of \code{x}. The function \code{splineDesign} in
##' \code{splines} package can also be used to calculate derivative of
##' B-splines.
##'
##' @usage
##' dbs(x, derivs = 1L, df = NULL, knots = NULL, degree = 3L,
##' intercept = FALSE, Boundary.knots = range(x, na.rm = TRUE), ...)
##'
##' @param x The predictor variable. Missing values are allowed and will be
##' kept and returned as they were.
##' @param derivs A positive integer specifying the order of derivative. By
##' default, it is \code{1L} for the first derivative.
##' @param df Degrees of freedom of the B-spline basis to be differentiated.
##' One can specify \code{df} rather than \code{knots}, then the function
##' chooses "df - degree" (minus one if there is an intercept) knots at
##' suitable quantiles of \code{x} (which will ignore missing values). The
##' default, \code{NULL}, corresponds to no inner knots, i.e.,
##' "degree - intercept".
##' @param knots The internal breakpoints that define the B-spline basis to be
##' differentiated. The default is \code{NULL}, which results in a basis
##' for ordinary polynomial regression. Typical values are the mean or
##' median for one knot, quantiles for more knots. See also
##' \code{Boundary.knots}.
##' @param degree Non-negative integer degree of the piecewise polynomial to be
##' differentiated. The default value is 3 for the integral of cubic
##' B-splines.
##' @param intercept If \code{TRUE}, an intercept is included in the basis;
##' Default is \code{FALSE}.
##' @param Boundary.knots Boundary points at which to anchor the B-spline basis
##' to be differentiated. By default, they are the range of the
##' non-\code{NA} data. If both \code{knots} and \code{Boundary.knots} are
##' supplied, the basis parameters do not depend on \code{x}.
##' @param ... Optional arguments for future usage.
##'
##' @return A matrix of dimension \code{length(x)} by
##' \code{df = degree + length(knots)} (plus on if intercept is included).
##' Attributes that correspond to the arguments specified are returned
##' for usage of other functions in this package.
##' @references
##' De Boor, Carl. (1978). \emph{A practical guide to splines}.
##' Vol. 27. New York: Springer-Verlag.
##' @examples
##' library(splines2)
##' x <- seq.int(0, 1, 0.01)
##' knots <- c(0.2, 0.4, 0.7)
##' ## the second derivative of cubic B-splines with three internal knots
##' dMat <- dbs(x, derivs = 2L, knots = knots, intercept = TRUE)
##'
##' ## compare with the results from splineDesign
##' ord <- attr(dMat, "degree") + 1L
##' bKnots <- attr(dMat, "Boundary.knots")
##' aKnots <- c(rep(bKnots[1L], ord), knots, rep(bKnots[2L], ord))
##' res <- splines::splineDesign(aKnots, x = x, derivs = 2L)
##' stopifnot(all.equal(res, dMat, check.attributes = FALSE))
##' @seealso
##' \code{\link{predict.dbs}} for evaluation at given (new) values;
##' \code{\link{deriv.dbs}} for derivative method;
##' \code{\link{bSpline}} for B-splines;
##' \code{\link{ibs}} for integral of B-splines.
##' @importFrom stats quantile
##' @export
dbs <- function(x, derivs = 1L, df = NULL, knots = NULL, degree = 3L,
intercept = FALSE, Boundary.knots = range(x, na.rm = TRUE), ...)
{
## check order of derivative
derivs <- as.integer(derivs)
if (derivs < 1L)
stop("'derivs' has to be a positive integer.")
## check and reformat 'degree'
if ((degree <- as.integer(degree)) < 0)
stop("'degree' must be a nonnegative integer.")
## sort and remove possible NA's in internal knots if exist
if (length(knots))
knots <- sort.int(knots)
## take care of possible NA's in `x`
nax <- is.na(x)
if (all(nax))
stop("'x' cannot be all NA's!")
nas <- any(nax)
## remove NA's
xx <- if (nas) x[! nax] else x
## check Boundary.knots specified by users
outside <- rep(FALSE, length(xx))
if (! missing(Boundary.knots)) {
Boundary.knots <- sort(Boundary.knots[seq_len(2)])
outside <- (xx < Boundary.knots[1L]) | (xx > Boundary.knots[2L])
}
## determine knots from df if missing
inter <- as.integer(intercept)
if (! is.null(df)) {
df0 <- length(knots) + degree + inter
if (tmp <- (df < df0))
warning(sprintf("'df' was too small; have used %d", df0))
df <- ifelse(tmp, df0, df)
nKnots <- df - degree - inter
if (is.null(knots) && nKnots > 0) {
quans <- seq.int(from = 0, to = 1,
length.out = nKnots + 2L)[- c(1L, nKnots + 2L)]
knots <- stats::quantile(xx[! outside], quans)
}
}
## update degree of freedom from inputs
df0 <- length(knots) + degree + 1L
df <- df0 - 1L + inter
## attribute knots for output
knotsAttr <- if (is.null(knots)) numeric(0L) else knots
## for derivs > degree
if (derivs > degree) {
## df == 0, i.e., no basis returned
if (! df)
warning("Degree of freedom is zero.")
dMat <- matrix(0, nrow = length(x), ncol = df)
if (nas)
dMat[nax, ] <- NA
tmp <- list(degree = degree,
knots = knotsAttr,
Boundary.knots = Boundary.knots,
intercept = intercept,
x = x, derivs = derivs)
attributes(dMat) <- c(attributes(dMat), tmp)
class(dMat) <- c("matrix", "dbs")
return(dMat)
}
## B-spline bases
dMat <- bSpline(xx, knots = knots, degree = degree - derivs,
intercept = TRUE, Boundary.knots = Boundary.knots, ...)
## derivative matrix
for (iter in seq_len(derivs)) {
## define knot sequence according to the bases being differentiated
ord <- degree - derivs + iter + 1L
aKnots <- sort(c(rep(Boundary.knots, ord), knots))
denom <- diff(aKnots, lag = ord - 1L)
facVec <- ifelse(denom > 0, (ord - 1L) / denom, 0)
dMat0 <- cbind(0, dMat, 0)
dMat <- sapply(seq_len(df0 - derivs + iter), function(a)
{
idx <- a : (a + 1L)
tmpMat <- dMat0[, idx, drop = FALSE]
facVec[idx[1L]] * tmpMat[, 1L, drop = FALSE] -
facVec[idx[2L]] * tmpMat[, 2L, drop = FALSE]
})
## recover dimension after sapply
if (! is.matrix(dMat))
dMat <- matrix(dMat, nrow = 1L)
}
## take care of intercept
if (! intercept)
dMat <- dMat[, - 1L, drop = FALSE]
## keep NA's as is
if (nas) {
nmat <- matrix(NA, length(nax), df)
nmat[! nax, ] <- dMat
dMat <- nmat
}
## add dimnames for consistency with returns from splines::bs
row.names(dMat) <- names(x)
colnames(dMat) <- as.character(seq_len(df))
## on attributes
tmp <- list(degree = degree,
knots = knotsAttr,
Boundary.knots = Boundary.knots,
intercept = intercept,
x = x, derivs = derivs)
attributes(dMat) <- c(attributes(dMat), tmp)
class(dMat) <- c("matrix", "dbs")
## return
dMat
}
splines2/vignettes/ 0000755 0001762 0000144 00000000000 13310532503 014014 5 ustar ligges users splines2/vignettes/splines2-intro.Rmd 0000644 0001762 0000144 00000023350 13155556756 017402 0 ustar ligges users ---
title: "Introduction to splines2"
author: Wenjie Wang
date: "`r Sys.Date()`"
bibliography:
- ../inst/bib/splines2.bib
vignette: >
%\VignetteIndexEntry{Introduction to splines2}
%\VignetteEngine{knitr::rmarkdown}
\usepackage[utf8]{inputenc}
output: rmarkdown::html_vignette
---
The package **splines2** is designed to be a supplementary package on splines.
It provides functions constructing a variety of spline bases that are not
available from the package **splines** shipped with **R**. Most functions have
a very similar user interface with the function `bs` in package
**splines**. Currently, **splines2** provides function constructing B-splines,
integral of B-splines, monotone splines (M-splines) and its integral
(I-splines), convex splines (C-splines), and their derivatives. Compared with
package **splines**, **splines2** allows piecewise constant basis for B-splines.
Also, it provides a more user-friendly function interface, more consistent
handling on `NA`'s for spline derivatives.
In this vignette, we introduce the basic usage of the functions provided by
examples. The details of function syntax are available in the package manual and
thus will be not discussed.
An outline of the remainder of the vignette is as follows: We first introduce
the functions constructing the monotone splines ([M-splines](#mSpline)), its
integral ([I-splines](#iSpline)), and convex splines ([C-splines](#cSpline)).
The `deriv` methods for derivatives is demonstrated at the same time. After
then, toy examples for [integral and derivative of B-splines](#ibs-dbs)
and [B-splines](#bSpline), M-splines allowing piecewise constant are given.
Last but not the least, handy methods of S3 generic function [predict](#predict)
for objects produced by **splines2** are demonstrated for the evaluation of the
same spline basis at new values.
## M-splines using `mSpline`{#mSpline}
M-splines [@ramsay1988monotone] can be considered as a normalized version of
B-splines with unit integral within boundary knots. An example given by
@ramsay1988monotone was a quadratic M-splines with three internal knots placed
at 0.3, 0.5, and 0.6. The boundary knots by default are the range of the data
`x`, thus 0 and 1 in this example.
```{r mSpline, fig.width=7, fig.height=4, fig.cap = "Quadratic M-splines with three internal knots."}
library(splines2)
knots <- c(0.3, 0.5, 0.6)
x <- seq(0, 1, 0.01)
msOut <- mSpline(x, knots = knots, degree = 2, intercept = TRUE)
library(graphics) # attach graphics (just in case) for plots
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, msOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray") # mark internal knots
```
The derivative of given order of M-splines can be obtained by specifying a
positive integer to argument `dervis` of `mSpline`. Also, for an existing
`mSpline` object generated from function `mSpline`, the `deriv` method can be
used conveniently. For example, the first derivative of the M-splines given
in last example can be obtained equivalently as follows:
```{r mSpline-derivs}
dmsOut1 <- mSpline(x, knots = knots, degree = 2, intercept = TRUE, derivs = 1)
dmsOut2 <- deriv(msOut)
stopifnot(all.equal(dmsOut1, dmsOut2, check.attributes = FALSE))
```
## I-splines using `iSpline` {#iSpline}
I-splines [@ramsay1988monotone] are simply the integral of M-splines and thus
monotonically non-decreasing with unit maximum value. A monotonically
non-decreasing (non-increasing) function can be fitted by a linear combination
of I-spline bases with non-negative (non-positive) coefficients, plus a constant
function (where the coefficient of the constant function is unconstrained).
The example given by @ramsay1988monotone was the I-splines corresponding to that
quadratic M-splines with three internal knots placed at 0.3, 0.5, and 0.6. Note
that the degree of I-splines is defined from the associated M-splines instead of
their own polynomial degree.
```{r iSpline, fig.width=7, fig.height=4, fig.cap = "I-splines of degree two with three internal knots."}
isOut <- iSpline(x, knots = knots, degree = 2, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, isOut, type = "l", ylab = "y")
abline(h = 1, v = knots, lty = 2, col = "gray")
```
The corresponding M-spline basis matrix can be obtained easily by the `deriv`
method, which internally exacts the attribute named `msMat` in the object
returned by function `iSpline`. In other words, if we need both M-spline bases
and their integral splines in model fitting, `iSpline` and its `deriv` method
should be used, while an extra function call of `mSpline` should be avoided for
a better performance.
```{r msMat}
stopifnot(all.equal(msOut, deriv(isOut)))
```
## C-splines using `cSpline` {#cSpline}
Convex splines [@meyer2008inference] called C-splines are a scaled version of
I-splines' integral with unit maximum value. @meyer2008inference applied
C-splines to shape-restricted regression analysis. The monotone property of
I-spines ensures the convexity of C-splines. A convex regression function can be
estimated using linear combinations of the C-spline bases with non-negative
coefficients, plus an unrestricted linear combination of the constant function
and the identity function $g(x)=x$. If the underlying regression function is
both increasing and convex, the coefficient on the identity function is
restricted to be nonnegative as well.
Function `cSpline` provides argument `scale` specifying whether scaling on
C-spline bases is required. If `scale = TRUE` (by default), each C-spline basis
is scaled to have unit height at right boundary knot. For its first (second)
derivative, the `deriv` method can be used, which internally exacts the
corresponding I-spline (M-spline) bases shipped in attributes `isMat` (`msMat`)
scaled to the same extent. The derivatives of higher order can be obtained by
specifying argument `derivs` in the `deriv` method.
```{r cSpline-scaled, fig.width=7, fig.height=4, fig.cap = "C-splines of degree two with three internal knots."}
csOut1 <- cSpline(x, knots = knots, degree = 2, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0))
matplot(x, csOut1, type = "l", ylab = "y")
abline(h = 1, v = knots, lty = 2, col = "gray")
```
If `scale = FALSE`, the actual integral of I-spline basis will be returned.
Similarly, the corresponding `deriv` method is provided. For derivatives of
order greater than one, the nested call of `deriv` is supported. However,
argument `derivs` can be specified if possible for a better performance. For
example, the first and second derivatives can be obtained by the following
equivalent approaches, respectively.
```{r cSpline-not-scaled}
csOut2 <- cSpline(x, knots = knots, degree = 2, intercept = TRUE, scale = FALSE)
stopifnot(all.equal(isOut, deriv(csOut2), check.attributes = FALSE))
stopifnot(all.equal(msOut, deriv(csOut2, 2), deriv(deriv(csOut2)),
check.attributes = FALSE))
```
## Integral and derivative of B-splines using `ibs` and `dbs` {#ibs-dbs}
A close-form recursive formulas of B-spline integral and derivative given by
@de1978practical are implemented. Two toy example are given as follows:
```{r ibs, fig.width=7, fig.height=4, fig.cap="Piecewise linear B-splines (left) and their integrals (right)."}
ibsOut <- ibs(x, knots = knots, degree = 1, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, deriv(ibsOut), type = "l", ylab = "y")
abline(v = knots, h = 1, lty = 2, col = "gray")
matplot(x, ibsOut, type = "l", ylab = "y")
abline(v = knots, h = c(0.15, 0.2, 0.25), lty = 2, col = "gray")
```
```{r dbs, fig.width=7, fig.height=4, fig.cap="Cubic B-splines (left) and their first derivative (right)."}
dbsOut <- dbs(x, knots = knots, intercept = TRUE)
bsOut <- bSpline(x, knots = knots, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, bsOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
matplot(x, dbsOut, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
```
## B-splines using `bSpline` {#bSpline}
Function `bSpline` provides B-spline bases and allows `degree = 0` for piecewise
constant bases, which is one simple but handy extension to function `bs` in
package **splines**. (For positive `degree`, `bSpline` internally call `bs` to
do the hard work.) Step function or piecewise constant bases (close on the left
and open on the right) are often used in practice for a reasonable approximation
without any assumption on the form of target function. One simple example of
B-splines and M-splines of degree zero is given as follows:
```{r bSpline, fig.width=7, fig.height=4, fig.cap="B-splines (left) and M-splines (right) of degree zero"}
bsOut0 <- bSpline(x, knots = knots, degree = 0, intercept = TRUE)
msOut0 <- mSpline(x, knots = knots, degree = 0, intercept = TRUE)
par(mar = c(2.5, 2.5, 0, 0), mgp = c(1.5, 0.5, 0), mfrow = c(1, 2))
matplot(x, bsOut0, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
matplot(x, msOut0, type = "l", ylab = "y")
abline(v = knots, lty = 2, col = "gray")
```
## Evaluation on New Values by `predict` {#predict}
The methods for **splines2** objects dispatched by generic function `predict`
are useful if we want to evaluate the spline object at possibly new $x$
values. For instance, if we want to evaluate the value of I-splines object in
previous example at 0.275, 0.525, and 0.8, respectively, all we need is
```{r predict}
predict(isOut, c(0.275, 0.525, 0.8))
```
Technically speaking, the methods take all information needed, such as `knots`,
`degree`, `intercept`, etc., from attributes of the original **splines2**
objects and call the corresponding function automatically for those new $x$
values. Therefore, the `predict` methods will not be applicable if those
attributes are somehow lost after certain operation.
## Reference
splines2/README.md 0000644 0001762 0000144 00000004725 13210337463 013302 0 ustar ligges users # splines2
The R package **splines2** is a supplementary package on splines providing
functions constructing B-splines, integral of B-splines, monotone splines
(M-splines) and its integral (I-splines), convex splines (C-splines), and their
derivatives of given order. Piecewise constant basis is allowed for B-spline and
M-spline basis.
## Installation of CRAN Version
[![CRAN_Status_Badge][r-pkg-badge]][cran-url]
[![Build Status][travis-master]][travis]
[![codecov][codecov-master]][codecov]
[![Downloads from the RStudio CRAN mirror][cranlog-badge]][cran-url]
You can install the released version from [CRAN][cran-url].
```R
install.packages("splines2")
```
## Development
[![Build Status][travis-dev]][travis]
[![codecov][codecov-dev]][codecov]
The latest version of package is under development at [GitHub][github-url] in
branch `dev`. If it is able to pass the building check by Travis CI, you may
consider installing it with the help of **remotes** by
```R
if (! require(remotes)) install.packages("remotes")
remotes::install_github("wenjie2wang/splines2", ref = "dev")
```
## Getting Started
The [package vignette][vignette] provides a quick demonstration for the basic
usage of the main functions.
## License
The R package **splines2** 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 3 of the License, or any later version
(at your option). See the [GNU General Public License][gpl] for details.
The R package **splines2** 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.
[r-pkg-badge]: https://www.r-pkg.org/badges/version/splines2
[cranlog-badge]: https://cranlogs.r-pkg.org/badges/splines2
[cran-url]: https://CRAN.R-project.org/package=splines2
[travis]: https://travis-ci.org/wenjie2wang/splines2
[travis-master]: https://travis-ci.org/wenjie2wang/splines2.svg?branch=master
[travis-dev]: https://travis-ci.org/wenjie2wang/splines2.svg?branch=dev
[github-url]: https://github.com/wenjie2wang/splines2
[vignette]: https://wenjie-stat.me/splines2/articles/splines2-intro.html
[gpl]: https://www.gnu.org/licenses/
[codecov]: https://codecov.io/gh/wenjie2wang/splines2
[codecov-master]: https://codecov.io/gh/wenjie2wang/splines2/branch/master/graph/badge.svg
[codecov-dev]: https://codecov.io/gh/wenjie2wang/splines2/branch/dev/graph/badge.svg
splines2/MD5 0000644 0001762 0000144 00000004177 13310535463 012335 0 ustar ligges users eed7693844c5bbc5951f794ce87ef375 *DESCRIPTION
33522d7352c491f9e7781007d733ee1a *NAMESPACE
990b386b080d91f6238fe0bee2365b59 *NEWS.md
2be84e3e040ba0410638d21f5dd1c45e *R/bSpline.R
134ba9d1891857f083fffa7ceec2fa4f *R/cSpline.R
15c17c9dbf49f4080761ce7bef7227e4 *R/dbs.R
b7146f4dbea97d3d6faded8a26026129 *R/deriv.R
d56d30161ffdf6b178eb2eb3aca2dc8a *R/iSpline.R
e6859339ae802a8a521789d1fa5ebb01 *R/ibs.R
f4ef028ffffaa3267b5555fae4967079 *R/mSpline.R
61bd83cd9d2efc37f9523c956d2b81e4 *R/misc.R
ed2bf67db688a05c6176b16f23f7d6aa *R/predict.R
408e5aa5ce20a6931ef5e3da86ae1dd3 *R/print.R
c2bff81ae9fdc6adde12d05aefdf4b1b *R/splines2-package.R
47bdf9eb989c692ac44c485360ebd729 *README.md
e4cd6bced247ea284c5acc8f9e3381dd *build/vignette.rds
50d5d6950d0b66fa50b5b1bb8d9f9249 *inst/CITATION
7e11a44c960abe5bc39ec3c43644b625 *inst/bib/splines2.bib
63701427a621d0efaf35f80859bd20ca *inst/doc/splines2-intro.R
060d6ab3117d9b79480299477a9642b3 *inst/doc/splines2-intro.Rmd
afbe9523649176fb42af1659cb11d08c *inst/doc/splines2-intro.html
f51a6e68cb8d081245105ee3eba00ad8 *man/bSpline.Rd
cbffa8542c0cc0b1ea52a52fa3fbc117 *man/cSpline.Rd
17ee5167d3e78d7e512b60f445828e70 *man/dbs.Rd
79235f72a2d46b708fa1954f95a16446 *man/deriv.Rd
eaec064fb082676363f257bb4646cf10 *man/iSpline.Rd
4bae51fea67ebbf08fa37a9634544541 *man/ibs.Rd
be3a1f72fa999a98121eefbb8a9b0c7d *man/mSpline.Rd
b6ed7681e29a91f5d877cbf659358099 *man/predict.Rd
dfc536fd05f3f844e6428138cfa67d4f *man/print.Rd
faf94420ad544cc61f0fe59bd5c772b4 *man/splines2.Rd
4a13e254a130b1b26f46f990d44d27ca *tests/testthat.R
d8d301c8d2628f8ce0d0ca8569a1eb25 *tests/testthat/test-bSpline.R
184bd9a7824be19c25facd9707af1238 *tests/testthat/test-cSpline.R
1780a5a223e9914ccfc1c67ef37bbfb7 *tests/testthat/test-dbs.R
21ca5ea973529662e15c6f7636477137 *tests/testthat/test-deriv.R
03fc824f92e9964de41ab9010fda37b9 *tests/testthat/test-iSpline.R
b9015d5c086d11b27528f913c124412a *tests/testthat/test-ibs.R
bede7ade79ec8fadb150e75bc8eb4350 *tests/testthat/test-mSpline.R
45eb8fdbf2067cdfdc18825eade31eea *tests/testthat/test-predict.R
384c3302cb7cf0e4cc7d976e1fd3d1c6 *tests/testthat/test-print.R
060d6ab3117d9b79480299477a9642b3 *vignettes/splines2-intro.Rmd
splines2/build/ 0000755 0001762 0000144 00000000000 13310532503 013103 5 ustar ligges users splines2/build/vignette.rds 0000644 0001762 0000144 00000000330 13310532503 015436 0 ustar ligges users b```b`f@&0`b fd`aB9yFy%EzA)h*$