R Under development (unstable) (2024-02-14 r85901 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > 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) | | | 0% | |========== | 14% | |==================== | 29% | |============================== | 43% | |======================================== | 57% | |================================================== | 71% | |============================================================ | 86% | |======================================================================| 100% > 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) dfs n_iknots iknots loglik rss rse wiggle fdsc 1 4 0 -74.49596 25.977023 0.5201865 46.88727 2 2 5 1 4.5 -60.10762 19.481116 0.4528403 46.14794 2 3 6 2 1, 4.5 -22.06652 9.103178 0.3111950 113.07351 4 4 7 3 1, 3, 4.5 -19.96710 8.728863 0.3063637 99.28601 4 5 8 4 1, 1.5, .... -19.95694 8.727089 0.3079930 95.78576 4 6 9 5 1, 1.5, .... -19.79792 8.699377 0.3091885 92.01369 4 7 10 6 1, 1.5, .... -19.67424 8.677886 0.3105172 87.35118 4 Pr(>w_(1)) 1 NA 2 1.8203e-08 3 < 2.22e-16 4 9.6222e-05 5 0.630871 6 0.072342 7 0.066713 ------- Elbows (index of selected model): loglik rss rse quadratic 3 3 3 linear 3 3 3 > stopifnot(identical(printed, s)) > > # only the first and last row: > printed <- print(s, n = 1) dfs n_iknots iknots loglik rss 1 4 0 -74.4959645891524 25.9770228656933 --- 7 10 6 1, 1.5, .... -19.6742417303079 8.67788603091469 rse wiggle fdsc Pr(>w_(1)) 1 0.520186493658097 46.8872701952964 2 NA --- 7 0.310517239294459 87.3511819271172 4 0.066713 ------- Elbows (index of selected model): loglik rss rse quadratic 3 3 3 linear 3 3 3 > stopifnot(identical(printed, s)) > > ################################################################################ > # End of File # > ################################################################################ > > proc.time() user system elapsed 1.98 0.14 2.10