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) > > ################################################################################ > # simple test of the cn.cpt_bt and cn.formula, should have the same elements > e <- new.env() > with(e, { + bt <- btensor(list(spdg$day, spdg$age) , df = list(30, 4) , bknots = list(c(-1, 1), c(44, 53))) + theta <- rnorm(30 * 4) + acn <- cn(bt, theta) + + bcn <- cn(pdg ~ btensor(list(day, age) + , df = list(30, 4) + , bknots = list(c(-1, 1), c(44, 53)) + ) + ttm + , data = spdg) + + stopifnot(inherits(acn, "cpr_cn")) + stopifnot(inherits(bcn, "cpr_cn")) + + stopifnot(identical(names(acn), names(bcn))) + + stopifnot(identical(names(acn), + c("cn", "bspline_list", "call", "keep_fit", "fit", "theta", "coefficients", "vcov", "vcov_theta", "loglik", "rss", "rse"))) + + }) > > ################################################################################ > # Verify that an error is thrown if btensor is not used as expected in the > # formula > e <- new.env() > with(e, { + test <- tryCatch(cn(log10(pdg) ~ age + ttm, data = spdg), error = function(e) e) + stopifnot(inherits(test, "error")) + stopifnot(identical(test$message, "btensor() must appear first, once, and with no effect modifiers, on the right hand side of the formula.")) + }) > > e <- new.env() > with(e, { + test <- tryCatch(cn(log10(pdg) ~ btensor(ttm)*age, data = spdg), error = function(e) e) + stopifnot(inherits(test, "error")) + stopifnot(identical(test$message, "btensor() must appear first, once, and with no effect modifiers, on the right hand side of the formula.")) + }) > > > ################################################################################ > # rank deficient? # > e <- new.env() > with(e, { + + # First, a good fit + bcn0 <- cn(pdg ~ btensor(list(day, age), df = list(30, 4), bknots = list(c(-1, 1), c(44, 53))) + ttm , data = spdg) + + stopifnot(inherits(bcn0, "cpr_cn")) + + # Now update to something that is rank deficient + bcn <- tryCatch(update_btensor(bcn0, iknots = list(c(0, 0, 0, 0, 0), numeric(0)), df = NULL), + warning = function(w) w) + + stopifnot(inherits(bcn, 'warning')) + stopifnot(identical(bcn$message, 'Design Matrix is rank deficient. keep_fit being set to TRUE.')) + + bcn <- tryCatch( + cn(pdg ~ btensor(list(day, age), iknots = list(c(0, 0,0, 0, 0), numeric(0)), bknots = list(c(-1, 1), c(44, 53))) + ttm + , data = spdg, keep_fit = FALSE) + , warning = function(w) w) + + stopifnot(inherits(bcn, 'warning')) + stopifnot(identical(bcn$message, 'Design Matrix is rank deficient. keep_fit being set to TRUE.')) + + }) > > ################################################################################ > ## printing method ## > e <- new.env() > with(e, { + bt <- btensor(list(spdg$day, spdg$age) , df = list(30, 4) , bknots = list(c(-1, 1), c(44, 53))) + theta <- rnorm(30 * 4) + acn <- cn(bt, theta) + + bcn <- cn(pdg ~ btensor(list(day, age) + , df = list(30, 4) + , bknots = list(c(-1, 1), c(44, 53)) + ) + ttm + , data = spdg) + + # verify the value is returned from the print call + stopifnot(identical(bcn, print(bcn))) + + + bcncap <- capture.output(print(bcn)) + expected <- capture.output(print(bcn$cn)) + stopifnot(identical(bcncap, expected)) + + }) Var1 Var2 theta 1 -1.00000000 44 -15.42687912 2 -0.97884309 44 -1.06561295 3 -0.94043431 44 1.04926348 4 -0.88654171 44 -0.08923477 5 -0.83632349 44 0.80071599 6 -0.78549517 44 -0.63644117 7 -0.73341577 44 0.05887334 8 -0.68076255 44 -0.10005576 9 -0.62907397 44 0.12810645 10 -0.57747612 44 -0.67750914 11 -0.52396877 44 0.18271597 12 -0.47108056 44 -0.11832653 13 -0.41766925 44 0.20611582 14 -0.36585204 44 -0.62865791 15 -0.31418567 44 0.40750474 16 -0.26184649 44 -0.25531776 17 -0.21070558 44 -0.50646116 18 -0.15882895 44 0.15699862 19 -0.10862186 44 -0.30874088 20 -0.05437142 44 -0.83087596 21 0.02441233 44 2.99356415 22 0.13007055 44 -2.34533356 23 0.25206071 44 3.39160248 24 0.37151090 44 1.49191094 25 0.49256742 44 5.98143762 26 0.61480861 44 0.44320243 27 0.73991149 44 1.64197557 28 0.86633600 44 -2.13111938 29 0.95402704 44 8.57547658 30 1.00000000 44 -24.23924344 31 -1.00000000 47 22.15313388 32 -0.97884309 47 1.11954824 33 -0.94043431 47 0.77522904 34 -0.88654171 47 0.77698665 35 -0.83632349 47 0.02107422 36 -0.78549517 47 0.99331194 37 -0.73341577 47 0.43184102 38 -0.68076255 47 0.24298456 39 -0.62907397 47 0.11732121 40 -0.57747612 47 0.80262817 41 -0.52396877 47 0.02918744 42 -0.47108056 47 0.13429272 43 -0.41766925 47 0.05281285 44 -0.36585204 47 0.58109618 45 -0.31418567 47 -0.14054873 46 -0.26184649 47 0.43390843 47 -0.21070558 47 0.66682736 48 -0.15882895 47 0.07334171 49 -0.10862186 47 0.79829306 50 -0.05437142 47 0.99423988 51 0.02441233 47 -1.76581502 52 0.13007055 47 4.39194714 53 0.25206071 47 1.90836288 54 0.37151090 47 7.36547258 55 0.49256742 47 4.38711803 56 0.61480861 47 13.13343051 57 0.73991149 47 5.03281920 58 0.86633600 47 8.41327812 59 0.95402704 47 -6.37209004 60 1.00000000 47 31.60766323 61 -1.00000000 50 -15.51073284 62 -0.97884309 50 1.23412955 63 -0.94043431 50 0.48929537 64 -0.88654171 50 0.37931734 65 -0.83632349 50 0.58982712 66 -0.78549517 50 -0.12397917 67 -0.73341577 50 0.09120743 68 -0.68076255 50 0.29257926 69 -0.62907397 50 0.02596286 70 -0.57747612 50 -0.20627429 71 -0.52396877 50 0.05567317 72 -0.47108056 50 0.20685119 73 -0.41766925 50 0.08979336 74 -0.36585204 50 -0.13471858 75 -0.31418567 50 0.28859722 76 -0.26184649 50 -0.02122781 77 -0.21070558 50 -0.06788318 78 -0.15882895 50 0.49726686 79 -0.10862186 50 -0.20760009 80 -0.05437142 50 0.55996234 81 0.02441233 50 1.47157751 82 0.13007055 50 0.04196493 83 0.25206071 50 3.26858864 84 0.37151090 50 3.41117187 85 0.49256742 50 6.33666777 86 0.61480861 50 -0.27948000 87 0.73991149 50 4.94134076 88 0.86633600 50 -2.37346251 89 0.95402704 50 10.40600502 90 1.00000000 50 -36.25848444 91 -1.00000000 53 1.90683391 92 -0.97884309 53 0.80182429 93 -0.94043431 53 0.37059272 94 -0.88654171 53 0.53948864 95 -0.83632349 53 0.17782366 96 -0.78549517 53 0.44876579 97 -0.73341577 53 0.16529651 98 -0.68076255 53 0.19880871 99 -0.62907397 53 0.25808385 100 -0.57747612 53 0.28437950 101 -0.52396877 53 0.20730173 102 -0.47108056 53 0.04547867 103 -0.41766925 53 0.18996551 104 -0.36585204 53 0.16002743 105 -0.31418567 53 0.16892788 106 -0.26184649 53 0.16084996 107 -0.21070558 53 0.35018876 108 -0.15882895 53 0.04771970 109 -0.10862186 53 0.74986886 110 -0.05437142 53 -0.04882211 111 0.02441233 53 1.02511692 112 0.13007055 53 1.01648143 113 0.25206071 53 3.47566758 114 0.37151090 53 3.16733052 115 0.49256742 53 7.25903772 116 0.61480861 53 6.82908641 117 0.73991149 53 4.02160184 118 0.86633600 53 4.27321668 119 0.95402704 53 -3.36262469 120 1.00000000 53 26.10235994 > > > ################################################################################ > # End of File # > ################################################################################ > > proc.time() user system elapsed 6.37 1.34 7.68