tests/test-summary.cpr_cpr.R

In dewittpe/cpr: Control Polygon Reduction

library(cpr)

set.seed(42)
x <- seq(0 + 1/5000, 6 - 1/5000, length.out = 100)
bmat <- bsplines(x, iknots = c(1, 1.5, 2.3, 4, 4.5), bknots = c(0, 6))
theta <- matrix(c(1, 0, 3.5, 4.2, 3.7, -0.5, -0.7, 2, 1.5), ncol = 1)
DF <- data.frame(x = x, truth = as.numeric(bmat %*% theta))
DF$y <- as.numeric(bmat %*% theta + rnorm(nrow(bmat), sd = 0.3))

initial_cp <-
  cp(y ~ bsplines(x, iknots = c(1, 1.5, 2.3, 3.0, 4, 4.5), bknots = c(0, 6))
     , data = DF
     , keep_fit = TRUE # default is FALSE
  )

cpr0 <- cpr(initial_cp)
s <- summary(cpr0)
stopifnot(identical(nrow(s), 7L))
stopifnot(identical(names(s), c("dfs", "n_iknots", "iknots", "loglik", "rss", "rse", "wiggle", "fdsc", "Pr(>w_(1))")))

stopifnot(isTRUE(
  all.equal(summary(cpr0[[1]])
            , s[1, c("dfs", "n_iknots", "iknots", "loglik", "rss", "rse", "wiggle", "fdsc")]
            , check.attributes = FALSE
)))

stopifnot(identical(
    attr(s, "elbow")
    ,
    structure(c(3, 3, 3, 3, 3, 3), dim = 2:3, dimnames = list(c("quadratic", "linear"), c("loglik", "rss", "rse")))
    )
)

# verify that print returns the object
printed <- print(s)
stopifnot(identical(printed, s))

# only the first and last row:
printed <- print(s, n = 1)
stopifnot(identical(printed, s))

################################################################################
#                                 End of File                                  #
################################################################################