File: test-iSpline.R

package info (click to toggle)
r-cran-splines2 0.5.4-2
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 2,020 kB
  • sloc: cpp: 3,232; sh: 13; makefile: 2
file content (138 lines) | stat: -rw-r--r-- 4,494 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
## 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 <- 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)
x2 <- c(- 1, 2, x)
b_knots <- c(0, 1)

## default cubic splines without internal knots
expect_eqt(iSpline(x), v2$iSpline(x))

## cubic splines with specified df
expect_eqt(iSpline(x, df = 5),
           v2$iSpline(x, df = 5))

## cubic splines with specified internal knots
expect_eqt(iSpline(x, knots = knots),
           v2$iSpline(x, knots = knots))

## qudractic splines without internal knots
expect_eqt(iSpline(x, degree = 2L),
           v2$iSpline(x, degree = 2L))

## complete basis with intercept
expect_eqt(iSpline(x, intercept = TRUE),
           v2$iSpline(x, intercept = TRUE))

## specified knots
expect_eqt(iSpline(x, knots = knots, intercept = TRUE),
           v2$iSpline(x, knots = knots, intercept = TRUE))

## specified df
expect_eqt(iSpline(x, df = 6, intercept = TRUE),
           v2$iSpline(x, df = 6, intercept = TRUE))

## degree zero
expect_eqt(iSpline(x, df = 5, degree = 0),
           v2$iSpline(x, df = 5, degree = 0))
expect_eqt(iSpline(x, df = 5, degree = 0, intercept = TRUE),
           v2$iSpline(x, df = 5, degree = 0, intercept = TRUE))
bsMat0a <- iSpline(x, degree = 0, intercept = TRUE)
bsMat0b <- iSpline(x, df = 5, degree = 0, intercept = FALSE)
bsMat0c <- iSpline(x, df = 5, degree = 0, intercept = TRUE)
bsMat0d <- iSpline(x, knots = knots, degree = 0, intercept = FALSE)
bsMat0e <- iSpline(x, knots = knots, degree = 0, intercept = TRUE)
expect_true(isNumMatrix(bsMat0a, 14L, 1L))
expect_equal(sum(is.na(bsMat0b)), 15L) # keep NA's as is
expect_true(isNumMatrix(bsMat0b, 14L, 5L))
expect_true(isNumMatrix(bsMat0c, 14L, 5L))
expect_true(isNumMatrix(bsMat0d, 14L, 3L))
expect_true(isNumMatrix(bsMat0e, 14L, 4L))
expect_true(isNumMatrix(
    iSpline(x, df = 10, knots = knots, degree = 0L, intercept = FALSE),
    14L, 3L))
expect_true(isNumMatrix(
    iSpline(x, df = 10, knots = knots,
            degree = 0, intercept = TRUE),
    14L, 4L))

## x outside of boundary
suppressWarnings({
    expect_eqt(
        iSpline(x2, df = 6, degree = 3, Boundary.knots = b_knots),
        v2$iSpline(x2, df = 6, degree = 3, Boundary.knots = b_knots)
    )
})
suppressWarnings({
    expect_eqt(
        iSpline(x2, knots = knots, degree = 3, Boundary.knots = b_knots),
        v2$iSpline(x2, knots = knots, degree = 3, Boundary.knots = b_knots)
    )
})

## keep names of x
names(x) <- sample(LETTERS, length(x), replace = TRUE)
expect_equal(rownames(iSpline(x)), names(x))

## equivalency with M-splines
expect_eqt(
    iSpline(x, df = 5, derivs = 1),
    mSpline(x, df = 5, intercept = TRUE)
)
expect_eqt(
    iSpline(x, knots = knots, degree = 2, derivs = 2),
    mSpline(x, knots = knots, degree = 2, derivs = 1, intercept = TRUE)
)
expect_eqt(
    iSpline(x, knots = knots, degree = 2, derivs = 3),
    mSpline(x, knots = knots, degree = 2, derivs = 2, intercept = TRUE)
)


### 2. check designed features with expectation
## NA is only allowed in x

## error if all of x are NA's
expect_error(iSpline(c(NA_real_, NA_real_), degree = 0))
expect_error(iSpline(c(NA, NA), df = 5))

## error if degree has NA or negative
expect_error(iSpline(x, degree = - 1))
expect_error(iSpline(x, degree = NA))

## error if df has NA or negative
expect_error(iSpline(x, df = - 1))
expect_error(iSpline(x, df = NA))

## error if knots has NA
expect_error(iSpline(x, knots = c(0.1, 0.5, NA)))
expect_error(iSpline(x, Boundary.knots = c(0.1, 0.5, NA)))

## error if boundary knots are inappropriate
expect_error(iSpline(x, Boundary.knots = 0.1))
expect_error(iSpline(x, Boundary.knots = c(0.1, 0.1)))
expect_error(iSpline(x, Boundary.knots = c(0.1, 0.5, 1)))

## error if empty matrix
expect_true(isNumMatrix(iSpline(x, degree = 0, intercept = TRUE),
                        length(x), 1))
expect_error(iSpline(x, degree = 0, intercept = FALSE))

## error if any internal knot is placed outside boundary
expect_error(iSpline(x, knots = c(- 0.1, 0.5), degree = 0))

## warning if any x outside of boundary
expect_warning(iSpline(c(x, 10), knots = knots, degree = 0,
                       Boundary.knots = c(0, 1)))
expect_warning(iSpline(c(x, 10), knots = knots, degree = 3,
                       Boundary.knots = c(0, 1)))

## error for negative derivs
expect_error(iSpline(x, derivs = - 1))