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 # ################################################################################