Nothing
## get implementations of v0.2.8 for reference
v2 <- new.env()
source("../v0.2.8.R", v2)
source("utils.R")
## helper functions
isNumMatrix <- v2$isNumMatrix
### 1. check correctness first
x <- seq.int(0, 1, 0.1)
knots <- c(0.3, 0.5, 0.6)
b_knots <- c(0, 1)
## without internal knots
nsMat0a <- nsk(x, df = 2, intercept = TRUE)
nsMat0b <- nsk(x, intercept = TRUE)
## integrals
nsMat1 <- nsk(x, intercept = FALSE, integral = TRUE)
## first derivatives
nsMat2 <- nsk(x, intercept = FALSE, derivs = 1)
## second derivatives
nsMat3 <- nsk(x, intercept = FALSE, derivs = 2)
## check matrix size
expect_true(isNumMatrix(nsMat0a, length(x), 2L))
expect_true(isNumMatrix(nsMat0b, length(x), 2L))
expect_true(isNumMatrix(nsMat1, length(x), 1L))
expect_true(isNumMatrix(nsMat2, length(x), 1L))
expect_true(isNumMatrix(nsMat3, length(x), 1L))
## natural spline basis
nsMat0 <- nsk(x, knots = knots, intercept = TRUE)
## integrals
nsMat1 <- nsk(x, knots = knots, intercept = TRUE, integral = TRUE)
## first derivatives
nsMat2 <- nsk(x, knots = knots, intercept = TRUE, derivs = 1)
## second derivatives
nsMat3 <- nsk(x, knots = knots, intercept = TRUE, derivs = 2)
## check matrix size
expect_true(isNumMatrix(nsMat0, length(x), length(knots) + 2L))
expect_true(isNumMatrix(nsMat1, length(x), length(knots) + 2L))
expect_true(isNumMatrix(nsMat2, length(x), length(knots) + 2L))
expect_true(isNumMatrix(nsMat3, length(x), length(knots) + 2L))
## update trim to 0
nsMat0 <- update(nsMat0, trim = 0)
nsMat1 <- update(nsMat1, trim = 0)
nsMat2 <- update(nsMat2, trim = 0)
nsMat3 <- update(nsMat3, trim = 0)
## check the returned H matrix in attribute
h_mat <- attr(nsMat0, "H")
bsMat <- bSpline(x, knots = knots, intercept = TRUE)
expect_eqt(nsMat0, bsMat %*% h_mat)
expect_eqt(nsMat1, ibs(x, knots = knots, intercept = TRUE) %*% h_mat)
expect_eqt(nsMat2, deriv(bsMat) %*% h_mat)
expect_eqt(nsMat3, deriv(bsMat, 2) %*% h_mat)
## specify df directly instead of knots
for (j in seq.int(2, 10)) {
expect_true(isNumMatrix(
nsk(x, df = j), length(x), j
))
}
## use the deriv method
expect_equivalent(nsMat0, deriv(nsMat1))
expect_equivalent(nsMat2, deriv(nsMat0))
expect_equivalent(nsMat3, deriv(nsMat2))
expect_equivalent(nsMat3, deriv(nsMat0, 2))
## check second derivatives at boundary knots
expect_true(all(abs(predict(nsMat3, 0)) < 1e-12))
expect_true(all(abs(predict(nsMat3, 1)) < 1e-12))
## keep names of x
names(x) <- sample(LETTERS, length(x), replace = TRUE)
expect_equal(rownames(nsk(x, df = 3)), names(x))
## for x outside of boundary
xx <- seq.int(- 1, 2, 0.05)
knots <- c(0.3, 0.4, 0.6, 0.8)
b_knots <- c(0, 1)
nsMat <- nsk(xx, knots = knots, intercept = TRUE,
Boundary.knots = b_knots)
d1Mat <- nsk(xx, knots = knots, intercept = TRUE,
Boundary.knots = b_knots, derivs = 1)
d2Mat <- nsk(xx, knots = knots, intercept = TRUE,
Boundary.knots = b_knots, derivs = 2)
iMat <- nsk(xx, knots = knots, intercept = TRUE,
Boundary.knots = b_knots, integral = TRUE)
expect_equal(nsMat[1:5, ] - nsMat[2:6, ], nsMat[2:6, ] - nsMat[3:7, ])
expect_equal(nsMat[seq.int(length(xx) - 10, length(xx) - 5), ] -
nsMat[seq.int(length(xx) - 9, length(xx) - 4), ],
nsMat[seq.int(length(xx) - 9, length(xx) - 4), ] -
nsMat[seq.int(length(xx) - 8, length(xx) - 3), ])
expect_equal(d1Mat[1:5, ], d1Mat[2:6, ])
expect_equal(d1Mat[seq.int(length(xx) - 10, length(xx) - 5), ],
d1Mat[seq.int(length(xx) - 9, length(xx) - 4), ])
expect_equivalent(d2Mat[1:5, ], matrix(0, ncol = ncol(d2Mat), nrow = 5))
expect_equivalent(tail(d2Mat, 5), matrix(0, ncol = ncol(d2Mat), nrow = 5))
expect_equivalent(iMat[1:5, ], matrix(0, ncol = ncol(iMat), nrow = 5))
## expect_equal(iMat[seq.int(length(xx) - 10, length(xx) - 5), 2] -
## iMat[seq.int(length(xx) - 9, length(xx) - 4), 2],
## iMat[seq.int(length(xx) - 9, length(xx) - 4), 2] -
## iMat[seq.int(length(xx) - 8, length(xx) - 3), 2])
expect_true(all(
iMat[seq.int(length(xx) - 10, length(xx) - 5), 5] -
iMat[seq.int(length(xx) - 9, length(xx) - 4), 5] <
iMat[seq.int(length(xx) - 9, length(xx) - 4), 5] -
iMat[seq.int(length(xx) - 8, length(xx) - 3), 5]
))
### 2. checking inputs
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.8)
x2 <- c(- 1, 2, x)
b_knots <- c(0, 1)
## expect errors
expect_error(nsk(x2, df = 5, derivs = - 1))
expect_error(nsk(x2, df = 1))
expect_error(nsk(rep(NA, 10), df = 2))
## make sure internal knots are unique
x1 <- c(rep(0, 100), runif(10))
expect_warning(nsk(x1, df = 5), "duplicated knots")
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.