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) > > ################################################################################ > e <- new.env() > with(e, { + x <- runif(n = 100, 0, 6)#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) + + iok <- influence_of_iknots(initial_cp) + + stopifnot(inherits(iok, "cpr_influence_of_iknots")) + + # if the following test for the names of the object changes make sure to + # update the @return section of the source file. + stopifnot(identical(names(iok), c("original_cp", "coarsened_cps", "restored_cps", "d", "influence", "chisq"))) + + s <- summary(iok) + + stopifnot(identical(dim(s), c(6L, 8L))) + stopifnot(identical(names(s), c("j", "iknot", "influence", "influence_rank", "chisq", "chisq_rank", "p_value", "os_p_value"))) + }) > > ################################################################################ > # verbose vs non-versbose > e <- new.env() > with(e, { + x <- runif(n = 100, 0, 6) + 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) + + iok0 <- influence_of_iknots(initial_cp, verbose = FALSE, cl = 0) + iok1 <- influence_of_iknots(initial_cp, verbose = FALSE, cl = 1) + iok2 <- influence_of_iknots(initial_cp, verbose = FALSE, cl = 2) + iok0v <- influence_of_iknots(initial_cp, verbose = TRUE, cl = 0) + iok1v <- influence_of_iknots(initial_cp, verbose = TRUE, cl = 1) + iok2v <- influence_of_iknots(initial_cp, verbose = TRUE, cl = 2) + + stopifnot(isTRUE(all.equal(iok0, iok1))) + stopifnot(isTRUE(all.equal(iok0, iok2))) + stopifnot(isTRUE(all.equal(iok0, iok0v))) + stopifnot(isTRUE(all.equal(iok0, iok1v))) + stopifnot(isTRUE(all.equal(iok0, iok2v))) + + }) There are 6 internal knots to evaluate Coarsening theta (step 1 of 6) getting meta data for coarsend basis matrices (step 2 of 6) generating coarsened control polygons (step 3 of 6) building theta hat (step 4 of 6) building restored control polygons (step 5 of 6) building test statistics (step 6 of 6) There are 6 internal knots to evaluate Coarsening theta (step 1 of 6) getting meta data for coarsend basis matrices (step 2 of 6) generating coarsened control polygons (step 3 of 6) building theta hat (step 4 of 6) building restored control polygons (step 5 of 6) building test statistics (step 6 of 6) There are 6 internal knots to evaluate Coarsening theta (step 1 of 6) getting meta data for coarsend basis matrices (step 2 of 6) generating coarsened control polygons (step 3 of 6) building theta hat (step 4 of 6) building restored control polygons (step 5 of 6) building test statistics (step 6 of 6) > > ################################################################################ > # CPR > # verbose vs non-versbose > e <- new.env() > with(e, { + x <- runif(n = 100, 0, 6) + 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) + cpr_run <- cpr(initial_cp) + + ioik_cpr <- influence_of_iknots(cpr_run) + + ioik_list <- lapply(cpr_run, influence_of_iknots) + + stopifnot(identical(ioik_cpr, ioik_cpr)) + + stopifnot( + identical( + attr(cpr_run, "ioik") + , + lapply(ioik_list, summary) + ) + ) + + stopifnot( + all.equal( + do.call(rbind, attr(cpr_run, "ioik")) + , + summary(ioik_cpr)[, 1:8] + , + check.attributes = FALSE + ) + ) + + stopifnot( + identical( + summary(ioik_cpr)[, "index"] + , + c(1, 2, 3, 3, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7) + ) + ) + + }) | | | 0% | |========== | 14% | |==================== | 29% | |============================== | 43% | |======================================== | 57% | |================================================== | 71% | |============================================================ | 86% | |======================================================================| 100% > > ################################################################################ > e <- new.env() > with(e, { + + # acn <- cn(pdg ~ btensor(list(day, age) + # , df = list(10, 8) + # , bknots = list(c(-1, 1), c(44, 53)) + # ) + ttm + # , data = spdg) + # + # str(acn, max.level = 1) + # + # influence_of_iknots(acn) + # + # acnr <- cnr(acn) + # stop("TEST NEEDS TO BE WRITTEN") + + + + }) NULL > > > ################################################################################ > # End of File # > ################################################################################ > > proc.time() user system elapsed 1.81 0.17 1.96