Last updated on 2024-12-01 18:49:14 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 1.3-8 | 9.65 | 121.92 | 131.57 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 1.3-8 | 8.51 | 87.96 | 96.47 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 1.3-8 | 225.41 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 1.3-8 | 215.39 | ERROR | |||
| r-devel-windows-x86_64 | 1.3-8 | 15.00 | 131.00 | 146.00 | ERROR | |
| r-patched-linux-x86_64 | 1.3-8 | 10.96 | 116.21 | 127.17 | ERROR | |
| r-release-linux-x86_64 | 1.3-8 | 10.40 | 114.40 | 124.80 | OK | |
| r-release-macos-arm64 | 1.3-8 | 69.00 | OK | |||
| r-release-macos-x86_64 | 1.3-8 | 96.00 | OK | |||
| r-release-windows-x86_64 | 1.3-8 | 14.00 | 132.00 | 146.00 | ERROR | |
| r-oldrel-macos-arm64 | 1.3-8 | 74.00 | OK | |||
| r-oldrel-macos-x86_64 | 1.3-8 | 160.00 | OK | |||
| r-oldrel-windows-x86_64 | 1.3-8 | 17.00 | 167.00 | 184.00 | ERROR |
Version: 1.3-8
Check: tests
Result: ERROR
Running ‘0_pt-ex.R’ [2s/3s]
Running ‘ex1.R’ [7s/9s]
Running ‘ex2-long.R’ [7s/10s]
Running ‘ex3.R’ [2s/3s]
Comparing ‘ex3.Rout’ to ‘ex3.Rout.save’ ...15,16c15,16
< Warning messages:
< 1: In cobs(weight, height, knots = weight, nknots = length(weight)) :
---
> Warning message:
> In cobs(weight, height, knots = weight, nknots = length(weight)) :
19,20d18
< 2: In cobs(weight, height, knots = weight, nknots = length(weight)) :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘multi-constr.R’ [4s/6s]
Running ‘roof.R’ [4s/4s]
Comparing ‘roof.Rout’ to ‘roof.Rout.save’ ... OK
Running ‘small-ex.R’ [3s/4s]
Comparing ‘small-ex.Rout’ to ‘small-ex.Rout.save’ ...24,25d23
< Warning message:
< In cobs(x, y) : drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘spline-ex.R’ [2s/3s]
Comparing ‘spline-ex.Rout’ to ‘spline-ex.Rout.save’ ... OK
Running ‘temp.R’ [3s/4s]
Comparing ‘temp.Rout’ to ‘temp.Rout.save’ ...445,446d444
< Warning in cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
456,457d453
< Warning in cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
463,464c459,460
< coef[1:5]: -0.39324840, -0.28115087, 0.05916295, -0.07465159, 0.31227753
< R^2 = 73.22% ; empirical tau (over all): 63/113 = 0.5575221 (target tau= 0.5)
---
> coef[1:5]: -0.40655906, -0.31473700, 0.05651823, -0.05681818, 0.28681956
> R^2 = 72.56% ; empirical tau (over all): 54/113 = 0.4778761 (target tau= 0.5)
470,473d465
<
< **** ERROR in algorithm: ifl = 18
<
<
476,478d467
< Warning message:
< In cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
481,482d469
< Warning in cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< The algorithm has not converged after 100 iterations
488,490c475
< [1] 1 2 9 10 17 18 20 21 22 23 26 27 35 36 42 47 48 49 52
< [20] 53 58 59 61 62 63 64 65 68 73 74 78 79 80 81 82 83 84 88
< [39] 90 91 94 98 100 101 102 104 108 109 111 112
---
> [1] 10 18 21 22 47 61 68 74 78 79 102 111
492,495c477
< [1] 3 4 5 6 7 8 11 12 13 14 15 16 19 24 25 28 29 30 31
< [20] 32 33 34 37 38 39 40 41 43 44 45 46 50 51 54 55 56 57 60
< [39] 66 67 69 70 71 72 75 76 77 85 86 87 89 92 93 95 96 97 99
< [58] 103 105 106 107 110 113
---
> [1] 5 8 25 38 39 50 54 77 85 97 113
Running ‘wind.R’ [8s/10s]
Running the tests in ‘tests/multi-constr.R’ failed.
Complete output:
> #### Examples which use the new feature of more than one 'constraint'.
>
> suppressMessages(library(cobs))
>
> ## do *not* show platform info here (as have *.Rout.save), but in 0_pt-ex.R
> options(digits = 6)
>
> if(!dev.interactive(orNone=TRUE)) pdf("multi-constr.pdf")
>
> source(system.file("util.R", package = "cobs"))
> source(system.file(package="Matrix", "test-tools-1.R", mustWork=TRUE))
Loading required package: tools
> ##--> tryCatch.W.E(), showProc.time(), assertError(), relErrV(), ...
> Lnx <- Sys.info()[["sysname"]] == "Linux"
> isMac <- Sys.info()[["sysname"]] == "Darwin"
> x86 <- (arch <- Sys.info()[["machine"]]) == "x86_64"
> noLdbl <- (.Machine$sizeof.longdouble <= 8) ## TRUE when --disable-long-double
> ## IGNORE_RDIFF_BEGIN
> Sys.info()
sysname
"Linux"
release
"6.10.11-amd64"
version
"#1 SMP PREEMPT_DYNAMIC Debian 6.10.11-1 (2024-09-22)"
nodename
"gimli2"
machine
"x86_64"
login
"hornik"
user
"hornik"
effective_user
"hornik"
> noLdbl
[1] FALSE
> ## IGNORE_RDIFF_END
>
>
> Rsq <- function(obj) {
+ stopifnot(inherits(obj, "cobs"), is.numeric(res <- obj$resid))
+ 1 - sum(res^2)/obj$SSy
+ }
> list_ <- function (...) `names<-`(list(...), vapply(sys.call()[-1L], as.character, ""))
> is.cobs <- function(x) inherits(x, "cobs")
>
> set.seed(908)
> x <- seq(-1,2, len = 50)
> f.true <- pnorm(2*x)
> y <- f.true + rnorm(50)/10
> plot(x,y); lines(x, f.true, col="gray", lwd=2, lty=3)
>
> ## constraint on derivative at right end:
> (con <- rbind(c(2 , max(x), 0))) # f'(x_n) == 0
[,1] [,2] [,3]
[1,] 2 2 0
>
> ## Using 'trace = 3' --> 'trace = 2' inside drqssbc2()
>
> ## Regression splines (lambda = 0)
> c2 <- cobs(x,y, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Warning message:
In cobs(x, y, trace = 3) :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> c2i <- cobs(x,y, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 5 x 6 (nz = 15 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 6 x 7 (nz = 18 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
> c2c <- cobs(x,y, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 5 x 7 (nz = 15 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
>
> c2IC <- cobs(x,y, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 5 x 4 (nz = 15 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 7 x 5 (nz = 21 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 9 x 6 (nz = 27 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 11 x 7 (nz = 33 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
> ## here, it's the same as just "i":
> all.equal(fitted(c2i), fitted(c2IC))
[1] "Mean relative difference: 0.0808156"
>
> c1 <- cobs(x,y, degree = 1, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Warning in cobs(x, y, degree = 1, trace = 3) :
The algorithm has not converged after 100 iterations
> c1i <- cobs(x,y, degree = 1, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 5 x 6 (nz = 10 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
> c1c <- cobs(x,y, degree = 1, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
>
> plot(c1)
> lines(predict(c1i), col="forest green")
> all.equal(fitted(c1), fitted(c1i), tol = 1e-9)# but not 1e-10
[1] "Mean relative difference: 0.0215671"
>
> ## now gives warning (not error):
> c1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 12 =^= 0.6%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 7 x 5 (nz = 17 =^= 0.49%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 9 x 6 (nz = 22 =^= 0.41%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> cp2 <- cobs(x,y, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 2 x 6 (nz = 6 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 2 x 7 (nz = 6 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
>
> ## Here, warning ".. 'ifl'.. " on *some* platforms (e.g. Windows 32bit) :
> r2i <- tryCatch.W.E( cobs(x,y, constraint = "increase", pointwise = con) )
qbsks2():
Performing general knot selection ...
Deleting unnecessary knots ...
> cp2i <- r2i$value
> ## IGNORE_RDIFF_BEGIN
> r2i$warning
NULL
> ## IGNORE_RDIFF_END
> ## when plotting it, we see that it gave a trivial constant!!
> cp2c <- cobs(x,y, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 4 x 4 (nz = 12 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 5 x 5 (nz = 15 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 6 x 6 (nz = 18 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 7 x 7 (nz = 21 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
>
> ## now gives warning (not error): but no warning on M1 mac -> IGNORE
> ## IGNORE_RDIFF_BEGIN
> cp2IC <- cobs(x,y, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 7 x 4 (nz = 21 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 9 x 5 (nz = 27 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 11 x 6 (nz = 33 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 13 x 7 (nz = 39 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
Warning message:
In cobs(x, y, constraint = c("inc", "concave"), pointwise = con, :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> ## IGNORE_RDIFF_END
> cp1 <- cobs(x,y, degree = 1, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 2 x 6 (nz = 4 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
> cp1i <- cobs(x,y, degree = 1, constraint = "increase", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 4 x 3 (nz = 8 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 7 x 6 (nz = 14 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
> cp1c <- cobs(x,y, degree = 1, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 4 x 4 (nz = 10 =^= 0.62%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 5 x 5 (nz = 13 =^= 0.52%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 6 x 6 (nz = 16 =^= 0.44%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
>
> cp1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 7 x 4 (nz = 16 =^= 0.57%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 9 x 5 (nz = 21 =^= 0.47%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 11 x 6 (nz = 26 =^= 0.39%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> ## Named list of all cobs() results above -- sort() collation order matters for ls() !
> (curLC <- Sys.getlocale("LC_COLLATE"))
[1] "C"
> Sys.setlocale("LC_COLLATE", "C")
[1] "C"
> cobsL <- mget(Filter(\(nm) is.cobs(.GlobalEnv[[nm]]), ls(patt="c[12p]")),
+ envir = .GlobalEnv)
> Sys.setlocale("LC_COLLATE", curLC) # reverting
[1] "C"
>
> knL <- lapply(cobsL, `[[`, "knots")
> str(knL[order(lengths(knL))])
List of 16
$ c2IC : num [1:2] -1 2
$ cp2IC: num [1:2] -1 2
$ cp2c : num [1:2] -1 2
$ c1IC : num [1:3] -1 0.776 2
$ c1c : num [1:3] -1 0.776 2
$ c2 : num [1:3] -1 -0.449 2
$ c2c : num [1:3] -1 0.163 2
$ cp1IC: num [1:3] -1 0.776 2
$ cp1c : num [1:3] -1 0.776 2
$ c2i : num [1:4] -1 0.163 0.776 2
$ cp2 : num [1:4] -1 -0.449 0.776 2
$ cp2i : num [1:4] -1 0.163 0.776 2
$ c1 : num [1:5] -1 -0.449 0.163 0.776 2
$ c1i : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1 : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1i : num [1:5] -1 -0.449 0.163 0.776 2
>
> gotRsqrs <- sapply(cobsL, Rsq)
> Rsqrs <- c(c1 = 0.95079126, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
+ c2 = 0.94637437, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
+ cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
+ cp2 = 0.94988863, cp2IC= 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487)
> ## M1 mac " = " , cp2IC= 0.91704726, " = " , cp2i = 0.94620178
> ## noLD " = " , cp2IC=-0.08244284, " = " , cp2i = 0.94636815
> ## ATLAS " = " , cp2IC= 0.91471729, " = " , cp2i = 0.94506339
> ## openBLAS " = " , cp2IC= 0.91738019, " = " , cp2i = 0.93589404
> ## MKL " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## Intel " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## ^^^^^^^^^^ ^^^^^^^^^^
> ## remove these two from testing, notably for the M1 Mac & noLD .. :
> ##iR2 <- if(!x86 || noLdbl) setdiff(names(cobsL), c("cp2IC", "cp2i")) else TRUE
> ## actually everywhere, because of ATLAS, openBLAS, MKL, Intel... :
> iR2 <- setdiff(names(cobsL), nR2 <- c("cp2IC", "cp2i"))
> ## IGNORE_RDIFF_BEGIN
> dput(signif(gotRsqrs, digits=8))
c(c1 = 0.95341697, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
c2 = 0.94864721, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
cp2 = 0.94988863, cp2IC = 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487
)
> all.equal(Rsqrs[iR2], gotRsqrs[iR2], tolerance=0)# 2.6277e-9 (Lnx F 38); 2.6898e-9 (M1 mac)
[1] "Mean relative difference: 0.000374227"
> all.equal(Rsqrs[nR2], gotRsqrs[nR2], tolerance=0)# differ; drastically only for 'noLD'
[1] "Mean relative difference: 2.18514e-09"
> ## IGNORE_RDIFF_END
> stopifnot(exprs = {
+ all.equal(Rsqrs[iR2], gotRsqrs[iR2])
+ identical(c(5L, 3L, 3L, 5L,
+ 3L, 2L, 3L, 4L,
+ 5L, 3L, 3L, 5L,
+ 4L, 2L, 2L, 4L), unname(lengths(knL)))
+ })
Error: Rsqrs[iR2] and gotRsqrs[iR2] are not equal:
Mean relative difference: 0.000374227
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 1.3-8
Check: tests
Result: ERROR
Running ‘0_pt-ex.R’ [2s/2s]
Running ‘ex1.R’ [5s/6s]
Running ‘ex2-long.R’ [5s/7s]
Running ‘ex3.R’ [2s/2s]
Comparing ‘ex3.Rout’ to ‘ex3.Rout.save’ ...15,16c15,16
< Warning messages:
< 1: In cobs(weight, height, knots = weight, nknots = length(weight)) :
---
> Warning message:
> In cobs(weight, height, knots = weight, nknots = length(weight)) :
19,20d18
< 2: In cobs(weight, height, knots = weight, nknots = length(weight)) :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘multi-constr.R’ [3s/3s]
Running ‘roof.R’ [3s/4s]
Comparing ‘roof.Rout’ to ‘roof.Rout.save’ ... OK
Running ‘small-ex.R’ [2s/3s]
Comparing ‘small-ex.Rout’ to ‘small-ex.Rout.save’ ...24,25d23
< Warning message:
< In cobs(x, y) : drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘spline-ex.R’ [2s/2s]
Comparing ‘spline-ex.Rout’ to ‘spline-ex.Rout.save’ ... OK
Running ‘temp.R’ [2s/3s]
Comparing ‘temp.Rout’ to ‘temp.Rout.save’ ...445,446d444
< Warning in cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
456,457d453
< Warning in cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
463,464c459,460
< coef[1:5]: -0.39324840, -0.28115087, 0.05916295, -0.07465159, 0.31227753
< R^2 = 73.22% ; empirical tau (over all): 63/113 = 0.5575221 (target tau= 0.5)
---
> coef[1:5]: -0.40655906, -0.31473700, 0.05651823, -0.05681818, 0.28681956
> R^2 = 72.56% ; empirical tau (over all): 54/113 = 0.4778761 (target tau= 0.5)
470,473d465
<
< **** ERROR in algorithm: ifl = 18
<
<
476,478d467
< Warning message:
< In cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
481,482d469
< Warning in cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< The algorithm has not converged after 100 iterations
488,490c475
< [1] 1 2 9 10 17 18 20 21 22 23 26 27 35 36 42 47 48 49 52
< [20] 53 58 59 61 62 63 64 65 68 73 74 78 79 80 81 82 83 84 88
< [39] 90 91 94 98 100 101 102 104 108 109 111 112
---
> [1] 10 18 21 22 47 61 68 74 78 79 102 111
492,495c477
< [1] 3 4 5 6 7 8 11 12 13 14 15 16 19 24 25 28 29 30 31
< [20] 32 33 34 37 38 39 40 41 43 44 45 46 50 51 54 55 56 57 60
< [39] 66 67 69 70 71 72 75 76 77 85 86 87 89 92 93 95 96 97 99
< [58] 103 105 106 107 110 113
---
> [1] 5 8 25 38 39 50 54 77 85 97 113
Running ‘wind.R’ [6s/9s]
Running the tests in ‘tests/multi-constr.R’ failed.
Complete output:
> #### Examples which use the new feature of more than one 'constraint'.
>
> suppressMessages(library(cobs))
>
> ## do *not* show platform info here (as have *.Rout.save), but in 0_pt-ex.R
> options(digits = 6)
>
> if(!dev.interactive(orNone=TRUE)) pdf("multi-constr.pdf")
>
> source(system.file("util.R", package = "cobs"))
> source(system.file(package="Matrix", "test-tools-1.R", mustWork=TRUE))
Loading required package: tools
> ##--> tryCatch.W.E(), showProc.time(), assertError(), relErrV(), ...
> Lnx <- Sys.info()[["sysname"]] == "Linux"
> isMac <- Sys.info()[["sysname"]] == "Darwin"
> x86 <- (arch <- Sys.info()[["machine"]]) == "x86_64"
> noLdbl <- (.Machine$sizeof.longdouble <= 8) ## TRUE when --disable-long-double
> ## IGNORE_RDIFF_BEGIN
> Sys.info()
sysname
"Linux"
release
"6.9.7-amd64"
version
"#1 SMP PREEMPT_DYNAMIC Debian 6.9.7-1 (2024-06-27)"
nodename
"gimli1"
machine
"x86_64"
login
"hornik"
user
"hornik"
effective_user
"hornik"
> noLdbl
[1] FALSE
> ## IGNORE_RDIFF_END
>
>
> Rsq <- function(obj) {
+ stopifnot(inherits(obj, "cobs"), is.numeric(res <- obj$resid))
+ 1 - sum(res^2)/obj$SSy
+ }
> list_ <- function (...) `names<-`(list(...), vapply(sys.call()[-1L], as.character, ""))
> is.cobs <- function(x) inherits(x, "cobs")
>
> set.seed(908)
> x <- seq(-1,2, len = 50)
> f.true <- pnorm(2*x)
> y <- f.true + rnorm(50)/10
> plot(x,y); lines(x, f.true, col="gray", lwd=2, lty=3)
>
> ## constraint on derivative at right end:
> (con <- rbind(c(2 , max(x), 0))) # f'(x_n) == 0
[,1] [,2] [,3]
[1,] 2 2 0
>
> ## Using 'trace = 3' --> 'trace = 2' inside drqssbc2()
>
> ## Regression splines (lambda = 0)
> c2 <- cobs(x,y, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Warning message:
In cobs(x, y, trace = 3) :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> c2i <- cobs(x,y, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 5 x 6 (nz = 15 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 6 x 7 (nz = 18 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
> c2c <- cobs(x,y, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 5 x 7 (nz = 15 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
>
> c2IC <- cobs(x,y, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 5 x 4 (nz = 15 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 7 x 5 (nz = 21 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 9 x 6 (nz = 27 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 11 x 7 (nz = 33 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
> ## here, it's the same as just "i":
> all.equal(fitted(c2i), fitted(c2IC))
[1] "Mean relative difference: 0.0808156"
>
> c1 <- cobs(x,y, degree = 1, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Warning in cobs(x, y, degree = 1, trace = 3) :
The algorithm has not converged after 100 iterations
> c1i <- cobs(x,y, degree = 1, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 5 x 6 (nz = 10 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
> c1c <- cobs(x,y, degree = 1, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
>
> plot(c1)
> lines(predict(c1i), col="forest green")
> all.equal(fitted(c1), fitted(c1i), tol = 1e-9)# but not 1e-10
[1] "Mean relative difference: 0.0215671"
>
> ## now gives warning (not error):
> c1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 12 =^= 0.6%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 7 x 5 (nz = 17 =^= 0.49%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 9 x 6 (nz = 22 =^= 0.41%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> cp2 <- cobs(x,y, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 2 x 6 (nz = 6 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 2 x 7 (nz = 6 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
>
> ## Here, warning ".. 'ifl'.. " on *some* platforms (e.g. Windows 32bit) :
> r2i <- tryCatch.W.E( cobs(x,y, constraint = "increase", pointwise = con) )
qbsks2():
Performing general knot selection ...
Deleting unnecessary knots ...
> cp2i <- r2i$value
> ## IGNORE_RDIFF_BEGIN
> r2i$warning
NULL
> ## IGNORE_RDIFF_END
> ## when plotting it, we see that it gave a trivial constant!!
> cp2c <- cobs(x,y, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 4 x 4 (nz = 12 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 5 x 5 (nz = 15 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 6 x 6 (nz = 18 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 7 x 7 (nz = 21 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
>
> ## now gives warning (not error): but no warning on M1 mac -> IGNORE
> ## IGNORE_RDIFF_BEGIN
> cp2IC <- cobs(x,y, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 7 x 4 (nz = 21 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 9 x 5 (nz = 27 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 11 x 6 (nz = 33 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 13 x 7 (nz = 39 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
Warning message:
In cobs(x, y, constraint = c("inc", "concave"), pointwise = con, :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> ## IGNORE_RDIFF_END
> cp1 <- cobs(x,y, degree = 1, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 2 x 6 (nz = 4 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
> cp1i <- cobs(x,y, degree = 1, constraint = "increase", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 4 x 3 (nz = 8 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 7 x 6 (nz = 14 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
> cp1c <- cobs(x,y, degree = 1, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 4 x 4 (nz = 10 =^= 0.62%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 5 x 5 (nz = 13 =^= 0.52%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 6 x 6 (nz = 16 =^= 0.44%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
>
> cp1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 7 x 4 (nz = 16 =^= 0.57%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 9 x 5 (nz = 21 =^= 0.47%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 11 x 6 (nz = 26 =^= 0.39%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> ## Named list of all cobs() results above -- sort() collation order matters for ls() !
> (curLC <- Sys.getlocale("LC_COLLATE"))
[1] "C"
> Sys.setlocale("LC_COLLATE", "C")
[1] "C"
> cobsL <- mget(Filter(\(nm) is.cobs(.GlobalEnv[[nm]]), ls(patt="c[12p]")),
+ envir = .GlobalEnv)
> Sys.setlocale("LC_COLLATE", curLC) # reverting
[1] "C"
>
> knL <- lapply(cobsL, `[[`, "knots")
> str(knL[order(lengths(knL))])
List of 16
$ c2IC : num [1:2] -1 2
$ cp2IC: num [1:2] -1 2
$ cp2c : num [1:2] -1 2
$ c1IC : num [1:3] -1 0.776 2
$ c1c : num [1:3] -1 0.776 2
$ c2 : num [1:3] -1 -0.449 2
$ c2c : num [1:3] -1 0.163 2
$ cp1IC: num [1:3] -1 0.776 2
$ cp1c : num [1:3] -1 0.776 2
$ c2i : num [1:4] -1 0.163 0.776 2
$ cp2 : num [1:4] -1 -0.449 0.776 2
$ cp2i : num [1:4] -1 0.163 0.776 2
$ c1 : num [1:5] -1 -0.449 0.163 0.776 2
$ c1i : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1 : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1i : num [1:5] -1 -0.449 0.163 0.776 2
>
> gotRsqrs <- sapply(cobsL, Rsq)
> Rsqrs <- c(c1 = 0.95079126, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
+ c2 = 0.94637437, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
+ cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
+ cp2 = 0.94988863, cp2IC= 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487)
> ## M1 mac " = " , cp2IC= 0.91704726, " = " , cp2i = 0.94620178
> ## noLD " = " , cp2IC=-0.08244284, " = " , cp2i = 0.94636815
> ## ATLAS " = " , cp2IC= 0.91471729, " = " , cp2i = 0.94506339
> ## openBLAS " = " , cp2IC= 0.91738019, " = " , cp2i = 0.93589404
> ## MKL " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## Intel " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## ^^^^^^^^^^ ^^^^^^^^^^
> ## remove these two from testing, notably for the M1 Mac & noLD .. :
> ##iR2 <- if(!x86 || noLdbl) setdiff(names(cobsL), c("cp2IC", "cp2i")) else TRUE
> ## actually everywhere, because of ATLAS, openBLAS, MKL, Intel... :
> iR2 <- setdiff(names(cobsL), nR2 <- c("cp2IC", "cp2i"))
> ## IGNORE_RDIFF_BEGIN
> dput(signif(gotRsqrs, digits=8))
c(c1 = 0.95341697, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
c2 = 0.94864721, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
cp2 = 0.94988863, cp2IC = 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487
)
> all.equal(Rsqrs[iR2], gotRsqrs[iR2], tolerance=0)# 2.6277e-9 (Lnx F 38); 2.6898e-9 (M1 mac)
[1] "Mean relative difference: 0.000374227"
> all.equal(Rsqrs[nR2], gotRsqrs[nR2], tolerance=0)# differ; drastically only for 'noLD'
[1] "Mean relative difference: 2.18514e-09"
> ## IGNORE_RDIFF_END
> stopifnot(exprs = {
+ all.equal(Rsqrs[iR2], gotRsqrs[iR2])
+ identical(c(5L, 3L, 3L, 5L,
+ 3L, 2L, 3L, 4L,
+ 5L, 3L, 3L, 5L,
+ 4L, 2L, 2L, 4L), unname(lengths(knL)))
+ })
Error: Rsqrs[iR2] and gotRsqrs[iR2] are not equal:
Mean relative difference: 0.000374227
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 1.3-8
Check: tests
Result: ERROR
Running ‘0_pt-ex.R’
Running ‘ex1.R’ [13s/44s]
Running ‘ex2-long.R’ [12s/47s]
Running ‘ex3.R’ [4s/11s]
Comparing ‘ex3.Rout’ to ‘ex3.Rout.save’ ...15,16c15,16
< Warning messages:
< 1: In cobs(weight, height, knots = weight, nknots = length(weight)) :
---
> Warning message:
> In cobs(weight, height, knots = weight, nknots = length(weight)) :
19,20d18
< 2: In cobs(weight, height, knots = weight, nknots = length(weight)) :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘multi-constr.R’ [7s/21s]
Running ‘roof.R’ [7s/20s]
Comparing ‘roof.Rout’ to ‘roof.Rout.save’ ... OK
Running ‘small-ex.R’ [4s/16s]
Comparing ‘small-ex.Rout’ to ‘small-ex.Rout.save’ ...24,25d23
< Warning message:
< In cobs(x, y) : drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘spline-ex.R’ [4s/10s]
Comparing ‘spline-ex.Rout’ to ‘spline-ex.Rout.save’ ... OK
Running ‘temp.R’ [6s/18s]
Comparing ‘temp.Rout’ to ‘temp.Rout.save’ ...445,446d444
< Warning in cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
456,457d453
< Warning in cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
463,464c459,460
< coef[1:5]: -0.39324840, -0.28115087, 0.05916295, -0.07465159, 0.31227753
< R^2 = 73.22% ; empirical tau (over all): 63/113 = 0.5575221 (target tau= 0.5)
---
> coef[1:5]: -0.40655906, -0.31473700, 0.05651823, -0.05681818, 0.28681956
> R^2 = 72.56% ; empirical tau (over all): 54/113 = 0.4778761 (target tau= 0.5)
470,473d465
<
< **** ERROR in algorithm: ifl = 18
<
<
476,478d467
< Warning message:
< In cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
481,482d469
< Warning in cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< The algorithm has not converged after 100 iterations
488,490c475
< [1] 1 2 9 10 17 18 20 21 22 23 26 27 35 36 42 47 48 49 52
< [20] 53 58 59 61 62 63 64 65 68 73 74 78 79 80 81 82 83 84 88
< [39] 90 91 94 98 100 101 102 104 108 109 111 112
---
> [1] 10 18 21 22 47 61 68 74 78 79 102 111
492,495c477
< [1] 3 4 5 6 7 8 11 12 13 14 15 16 19 24 25 28 29 30 31
< [20] 32 33 34 37 38 39 40 41 43 44 45 46 50 51 54 55 56 57 60
< [39] 66 67 69 70 71 72 75 76 77 85 86 87 89 92 93 95 96 97 99
< [58] 103 105 106 107 110 113
---
> [1] 5 8 25 38 39 50 54 77 85 97 113
Running ‘wind.R’ [15s/39s]
Running the tests in ‘tests/multi-constr.R’ failed.
Complete output:
> #### Examples which use the new feature of more than one 'constraint'.
>
> suppressMessages(library(cobs))
>
> ## do *not* show platform info here (as have *.Rout.save), but in 0_pt-ex.R
> options(digits = 6)
>
> if(!dev.interactive(orNone=TRUE)) pdf("multi-constr.pdf")
>
> source(system.file("util.R", package = "cobs"))
> source(system.file(package="Matrix", "test-tools-1.R", mustWork=TRUE))
Loading required package: tools
> ##--> tryCatch.W.E(), showProc.time(), assertError(), relErrV(), ...
> Lnx <- Sys.info()[["sysname"]] == "Linux"
> isMac <- Sys.info()[["sysname"]] == "Darwin"
> x86 <- (arch <- Sys.info()[["machine"]]) == "x86_64"
> noLdbl <- (.Machine$sizeof.longdouble <= 8) ## TRUE when --disable-long-double
> ## IGNORE_RDIFF_BEGIN
> Sys.info()
sysname
"Linux"
release
"6.2.15-100.fc36.x86_64"
version
"#1 SMP PREEMPT_DYNAMIC Thu May 11 16:51:53 UTC 2023"
nodename
"gannet.stats.ox.ac.uk"
machine
"x86_64"
login
"ripley"
user
"ripley"
effective_user
"ripley"
> noLdbl
[1] FALSE
> ## IGNORE_RDIFF_END
>
>
> Rsq <- function(obj) {
+ stopifnot(inherits(obj, "cobs"), is.numeric(res <- obj$resid))
+ 1 - sum(res^2)/obj$SSy
+ }
> list_ <- function (...) `names<-`(list(...), vapply(sys.call()[-1L], as.character, ""))
> is.cobs <- function(x) inherits(x, "cobs")
>
> set.seed(908)
> x <- seq(-1,2, len = 50)
> f.true <- pnorm(2*x)
> y <- f.true + rnorm(50)/10
> plot(x,y); lines(x, f.true, col="gray", lwd=2, lty=3)
>
> ## constraint on derivative at right end:
> (con <- rbind(c(2 , max(x), 0))) # f'(x_n) == 0
[,1] [,2] [,3]
[1,] 2 2 0
>
> ## Using 'trace = 3' --> 'trace = 2' inside drqssbc2()
>
> ## Regression splines (lambda = 0)
> c2 <- cobs(x,y, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Warning message:
In cobs(x, y, trace = 3) :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> c2i <- cobs(x,y, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 5 x 6 (nz = 15 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 6 x 7 (nz = 18 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
> c2c <- cobs(x,y, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 5 x 7 (nz = 15 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
>
> c2IC <- cobs(x,y, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 5 x 4 (nz = 15 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 7 x 5 (nz = 21 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 9 x 6 (nz = 27 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 11 x 7 (nz = 33 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
> ## here, it's the same as just "i":
> all.equal(fitted(c2i), fitted(c2IC))
[1] "Mean relative difference: 0.0808156"
>
> c1 <- cobs(x,y, degree = 1, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Warning in cobs(x, y, degree = 1, trace = 3) :
The algorithm has not converged after 100 iterations
> c1i <- cobs(x,y, degree = 1, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 5 x 6 (nz = 10 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
> c1c <- cobs(x,y, degree = 1, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
>
> plot(c1)
> lines(predict(c1i), col="forest green")
> all.equal(fitted(c1), fitted(c1i), tol = 1e-9)# but not 1e-10
[1] "Mean relative difference: 0.0215671"
>
> ## now gives warning (not error):
> c1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 12 =^= 0.6%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 7 x 5 (nz = 17 =^= 0.49%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 9 x 6 (nz = 22 =^= 0.41%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> cp2 <- cobs(x,y, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 2 x 6 (nz = 6 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 2 x 7 (nz = 6 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
>
> ## Here, warning ".. 'ifl'.. " on *some* platforms (e.g. Windows 32bit) :
> r2i <- tryCatch.W.E( cobs(x,y, constraint = "increase", pointwise = con) )
qbsks2():
Performing general knot selection ...
Deleting unnecessary knots ...
> cp2i <- r2i$value
> ## IGNORE_RDIFF_BEGIN
> r2i$warning
NULL
> ## IGNORE_RDIFF_END
> ## when plotting it, we see that it gave a trivial constant!!
> cp2c <- cobs(x,y, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 4 x 4 (nz = 12 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 5 x 5 (nz = 15 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 6 x 6 (nz = 18 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 7 x 7 (nz = 21 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
>
> ## now gives warning (not error): but no warning on M1 mac -> IGNORE
> ## IGNORE_RDIFF_BEGIN
> cp2IC <- cobs(x,y, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 7 x 4 (nz = 21 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 9 x 5 (nz = 27 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 11 x 6 (nz = 33 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 13 x 7 (nz = 39 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
Warning message:
In cobs(x, y, constraint = c("inc", "concave"), pointwise = con, :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> ## IGNORE_RDIFF_END
> cp1 <- cobs(x,y, degree = 1, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 2 x 6 (nz = 4 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
> cp1i <- cobs(x,y, degree = 1, constraint = "increase", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 4 x 3 (nz = 8 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 7 x 6 (nz = 14 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
> cp1c <- cobs(x,y, degree = 1, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 4 x 4 (nz = 10 =^= 0.62%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 5 x 5 (nz = 13 =^= 0.52%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 6 x 6 (nz = 16 =^= 0.44%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
>
> cp1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 7 x 4 (nz = 16 =^= 0.57%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 9 x 5 (nz = 21 =^= 0.47%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 11 x 6 (nz = 26 =^= 0.39%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> ## Named list of all cobs() results above -- sort() collation order matters for ls() !
> (curLC <- Sys.getlocale("LC_COLLATE"))
[1] "C"
> Sys.setlocale("LC_COLLATE", "C")
[1] "C"
> cobsL <- mget(Filter(\(nm) is.cobs(.GlobalEnv[[nm]]), ls(patt="c[12p]")),
+ envir = .GlobalEnv)
> Sys.setlocale("LC_COLLATE", curLC) # reverting
[1] "C"
>
> knL <- lapply(cobsL, `[[`, "knots")
> str(knL[order(lengths(knL))])
List of 16
$ c2IC : num [1:2] -1 2
$ cp2IC: num [1:2] -1 2
$ cp2c : num [1:2] -1 2
$ c1IC : num [1:3] -1 0.776 2
$ c1c : num [1:3] -1 0.776 2
$ c2 : num [1:3] -1 -0.449 2
$ c2c : num [1:3] -1 0.163 2
$ cp1IC: num [1:3] -1 0.776 2
$ cp1c : num [1:3] -1 0.776 2
$ c2i : num [1:4] -1 0.163 0.776 2
$ cp2 : num [1:4] -1 -0.449 0.776 2
$ cp2i : num [1:4] -1 0.163 0.776 2
$ c1 : num [1:5] -1 -0.449 0.163 0.776 2
$ c1i : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1 : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1i : num [1:5] -1 -0.449 0.163 0.776 2
>
> gotRsqrs <- sapply(cobsL, Rsq)
> Rsqrs <- c(c1 = 0.95079126, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
+ c2 = 0.94637437, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
+ cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
+ cp2 = 0.94988863, cp2IC= 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487)
> ## M1 mac " = " , cp2IC= 0.91704726, " = " , cp2i = 0.94620178
> ## noLD " = " , cp2IC=-0.08244284, " = " , cp2i = 0.94636815
> ## ATLAS " = " , cp2IC= 0.91471729, " = " , cp2i = 0.94506339
> ## openBLAS " = " , cp2IC= 0.91738019, " = " , cp2i = 0.93589404
> ## MKL " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## Intel " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## ^^^^^^^^^^ ^^^^^^^^^^
> ## remove these two from testing, notably for the M1 Mac & noLD .. :
> ##iR2 <- if(!x86 || noLdbl) setdiff(names(cobsL), c("cp2IC", "cp2i")) else TRUE
> ## actually everywhere, because of ATLAS, openBLAS, MKL, Intel... :
> iR2 <- setdiff(names(cobsL), nR2 <- c("cp2IC", "cp2i"))
> ## IGNORE_RDIFF_BEGIN
> dput(signif(gotRsqrs, digits=8))
c(c1 = 0.95341697, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
c2 = 0.94864721, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
cp2 = 0.94988863, cp2IC = 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487
)
> all.equal(Rsqrs[iR2], gotRsqrs[iR2], tolerance=0)# 2.6277e-9 (Lnx F 38); 2.6898e-9 (M1 mac)
[1] "Mean relative difference: 0.000374227"
> all.equal(Rsqrs[nR2], gotRsqrs[nR2], tolerance=0)# differ; drastically only for 'noLD'
[1] "Mean relative difference: 2.18514e-09"
> ## IGNORE_RDIFF_END
> stopifnot(exprs = {
+ all.equal(Rsqrs[iR2], gotRsqrs[iR2])
+ identical(c(5L, 3L, 3L, 5L,
+ 3L, 2L, 3L, 4L,
+ 5L, 3L, 3L, 5L,
+ 4L, 2L, 2L, 4L), unname(lengths(knL)))
+ })
Error: Rsqrs[iR2] and gotRsqrs[iR2] are not equal:
Mean relative difference: 0.000374227
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 1.3-8
Check: tests
Result: ERROR
Running ‘0_pt-ex.R’
Running ‘ex1.R’ [12s/40s]
Running ‘ex2-long.R’ [12s/30s]
Running ‘ex3.R’ [4s/14s]
Comparing ‘ex3.Rout’ to ‘ex3.Rout.save’ ...15,16c15,16
< Warning messages:
< 1: In cobs(weight, height, knots = weight, nknots = length(weight)) :
---
> Warning message:
> In cobs(weight, height, knots = weight, nknots = length(weight)) :
19,20d18
< 2: In cobs(weight, height, knots = weight, nknots = length(weight)) :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘multi-constr.R’ [7s/16s]
Running ‘roof.R’ [6s/14s]
Comparing ‘roof.Rout’ to ‘roof.Rout.save’ ... OK
Running ‘small-ex.R’
Comparing ‘small-ex.Rout’ to ‘small-ex.Rout.save’ ...24,25d23
< Warning message:
< In cobs(x, y) : drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘spline-ex.R’
Comparing ‘spline-ex.Rout’ to ‘spline-ex.Rout.save’ ... OK
Running ‘temp.R’ [5s/20s]
Comparing ‘temp.Rout’ to ‘temp.Rout.save’ ...445,446d444
< Warning in cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
456,457d453
< Warning in cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
463,464c459,460
< coef[1:5]: -0.39324840, -0.28115087, 0.05916295, -0.07465159, 0.31227753
< R^2 = 73.22% ; empirical tau (over all): 63/113 = 0.5575221 (target tau= 0.5)
---
> coef[1:5]: -0.40655906, -0.31473700, 0.05651823, -0.05681818, 0.28681956
> R^2 = 72.56% ; empirical tau (over all): 54/113 = 0.4778761 (target tau= 0.5)
470,473d465
<
< **** ERROR in algorithm: ifl = 18
<
<
476,478d467
< Warning message:
< In cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
481,482d469
< Warning in cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< The algorithm has not converged after 100 iterations
488,490c475
< [1] 1 2 9 10 17 18 20 21 22 23 26 27 35 36 42 47 48 49 52
< [20] 53 58 59 61 62 63 64 65 68 73 74 78 79 80 81 82 83 84 88
< [39] 90 91 94 98 100 101 102 104 108 109 111 112
---
> [1] 10 18 21 22 47 61 68 74 78 79 102 111
492,495c477
< [1] 3 4 5 6 7 8 11 12 13 14 15 16 19 24 25 28 29 30 31
< [20] 32 33 34 37 38 39 40 41 43 44 45 46 50 51 54 55 56 57 60
< [39] 66 67 69 70 71 72 75 76 77 85 86 87 89 92 93 95 96 97 99
< [58] 103 105 106 107 110 113
---
> [1] 5 8 25 38 39 50 54 77 85 97 113
Running ‘wind.R’ [14s/51s]
Running the tests in ‘tests/multi-constr.R’ failed.
Complete output:
> #### Examples which use the new feature of more than one 'constraint'.
>
> suppressMessages(library(cobs))
>
> ## do *not* show platform info here (as have *.Rout.save), but in 0_pt-ex.R
> options(digits = 6)
>
> if(!dev.interactive(orNone=TRUE)) pdf("multi-constr.pdf")
>
> source(system.file("util.R", package = "cobs"))
> source(system.file(package="Matrix", "test-tools-1.R", mustWork=TRUE))
Loading required package: tools
> ##--> tryCatch.W.E(), showProc.time(), assertError(), relErrV(), ...
> Lnx <- Sys.info()[["sysname"]] == "Linux"
> isMac <- Sys.info()[["sysname"]] == "Darwin"
> x86 <- (arch <- Sys.info()[["machine"]]) == "x86_64"
> noLdbl <- (.Machine$sizeof.longdouble <= 8) ## TRUE when --disable-long-double
> ## IGNORE_RDIFF_BEGIN
> Sys.info()
sysname
"Linux"
release
"6.2.15-100.fc36.x86_64"
version
"#1 SMP PREEMPT_DYNAMIC Thu May 11 16:51:53 UTC 2023"
nodename
"gannet.stats.ox.ac.uk"
machine
"x86_64"
login
"ripley"
user
"ripley"
effective_user
"ripley"
> noLdbl
[1] FALSE
> ## IGNORE_RDIFF_END
>
>
> Rsq <- function(obj) {
+ stopifnot(inherits(obj, "cobs"), is.numeric(res <- obj$resid))
+ 1 - sum(res^2)/obj$SSy
+ }
> list_ <- function (...) `names<-`(list(...), vapply(sys.call()[-1L], as.character, ""))
> is.cobs <- function(x) inherits(x, "cobs")
>
> set.seed(908)
> x <- seq(-1,2, len = 50)
> f.true <- pnorm(2*x)
> y <- f.true + rnorm(50)/10
> plot(x,y); lines(x, f.true, col="gray", lwd=2, lty=3)
>
> ## constraint on derivative at right end:
> (con <- rbind(c(2 , max(x), 0))) # f'(x_n) == 0
[,1] [,2] [,3]
[1,] 2 2 0
>
> ## Using 'trace = 3' --> 'trace = 2' inside drqssbc2()
>
> ## Regression splines (lambda = 0)
> c2 <- cobs(x,y, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Warning message:
In cobs(x, y, trace = 3) :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> c2i <- cobs(x,y, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 5 x 6 (nz = 15 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 6 x 7 (nz = 18 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
> c2c <- cobs(x,y, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 5 x 7 (nz = 15 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
>
> c2IC <- cobs(x,y, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 5 x 4 (nz = 15 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 7 x 5 (nz = 21 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 9 x 6 (nz = 27 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 11 x 7 (nz = 33 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
> ## here, it's the same as just "i":
> all.equal(fitted(c2i), fitted(c2IC))
[1] "Mean relative difference: 0.0808156"
>
> c1 <- cobs(x,y, degree = 1, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Warning in cobs(x, y, degree = 1, trace = 3) :
The algorithm has not converged after 100 iterations
> c1i <- cobs(x,y, degree = 1, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 5 x 6 (nz = 10 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
> c1c <- cobs(x,y, degree = 1, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
>
> plot(c1)
> lines(predict(c1i), col="forest green")
> all.equal(fitted(c1), fitted(c1i), tol = 1e-9)# but not 1e-10
[1] "Mean relative difference: 0.0215671"
>
> ## now gives warning (not error):
> c1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 12 =^= 0.6%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 7 x 5 (nz = 17 =^= 0.49%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 9 x 6 (nz = 22 =^= 0.41%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> cp2 <- cobs(x,y, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 2 x 6 (nz = 6 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 2 x 7 (nz = 6 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
>
> ## Here, warning ".. 'ifl'.. " on *some* platforms (e.g. Windows 32bit) :
> r2i <- tryCatch.W.E( cobs(x,y, constraint = "increase", pointwise = con) )
qbsks2():
Performing general knot selection ...
Deleting unnecessary knots ...
> cp2i <- r2i$value
> ## IGNORE_RDIFF_BEGIN
> r2i$warning
NULL
> ## IGNORE_RDIFF_END
> ## when plotting it, we see that it gave a trivial constant!!
> cp2c <- cobs(x,y, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 4 x 4 (nz = 12 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 5 x 5 (nz = 15 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 6 x 6 (nz = 18 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 7 x 7 (nz = 21 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
>
> ## now gives warning (not error): but no warning on M1 mac -> IGNORE
> ## IGNORE_RDIFF_BEGIN
> cp2IC <- cobs(x,y, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 7 x 4 (nz = 21 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 9 x 5 (nz = 27 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 11 x 6 (nz = 33 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 13 x 7 (nz = 39 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
Warning message:
In cobs(x, y, constraint = c("inc", "concave"), pointwise = con, :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> ## IGNORE_RDIFF_END
> cp1 <- cobs(x,y, degree = 1, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 2 x 6 (nz = 4 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
> cp1i <- cobs(x,y, degree = 1, constraint = "increase", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 4 x 3 (nz = 8 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 7 x 6 (nz = 14 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
> cp1c <- cobs(x,y, degree = 1, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 4 x 4 (nz = 10 =^= 0.62%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 5 x 5 (nz = 13 =^= 0.52%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 6 x 6 (nz = 16 =^= 0.44%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
>
> cp1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 7 x 4 (nz = 16 =^= 0.57%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 9 x 5 (nz = 21 =^= 0.47%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 11 x 6 (nz = 26 =^= 0.39%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> ## Named list of all cobs() results above -- sort() collation order matters for ls() !
> (curLC <- Sys.getlocale("LC_COLLATE"))
[1] "C"
> Sys.setlocale("LC_COLLATE", "C")
[1] "C"
> cobsL <- mget(Filter(\(nm) is.cobs(.GlobalEnv[[nm]]), ls(patt="c[12p]")),
+ envir = .GlobalEnv)
> Sys.setlocale("LC_COLLATE", curLC) # reverting
[1] "C"
>
> knL <- lapply(cobsL, `[[`, "knots")
> str(knL[order(lengths(knL))])
List of 16
$ c2IC : num [1:2] -1 2
$ cp2IC: num [1:2] -1 2
$ cp2c : num [1:2] -1 2
$ c1IC : num [1:3] -1 0.776 2
$ c1c : num [1:3] -1 0.776 2
$ c2 : num [1:3] -1 -0.449 2
$ c2c : num [1:3] -1 0.163 2
$ cp1IC: num [1:3] -1 0.776 2
$ cp1c : num [1:3] -1 0.776 2
$ c2i : num [1:4] -1 0.163 0.776 2
$ cp2 : num [1:4] -1 -0.449 0.776 2
$ cp2i : num [1:4] -1 0.163 0.776 2
$ c1 : num [1:5] -1 -0.449 0.163 0.776 2
$ c1i : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1 : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1i : num [1:5] -1 -0.449 0.163 0.776 2
>
> gotRsqrs <- sapply(cobsL, Rsq)
> Rsqrs <- c(c1 = 0.95079126, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
+ c2 = 0.94637437, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
+ cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
+ cp2 = 0.94988863, cp2IC= 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487)
> ## M1 mac " = " , cp2IC= 0.91704726, " = " , cp2i = 0.94620178
> ## noLD " = " , cp2IC=-0.08244284, " = " , cp2i = 0.94636815
> ## ATLAS " = " , cp2IC= 0.91471729, " = " , cp2i = 0.94506339
> ## openBLAS " = " , cp2IC= 0.91738019, " = " , cp2i = 0.93589404
> ## MKL " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## Intel " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## ^^^^^^^^^^ ^^^^^^^^^^
> ## remove these two from testing, notably for the M1 Mac & noLD .. :
> ##iR2 <- if(!x86 || noLdbl) setdiff(names(cobsL), c("cp2IC", "cp2i")) else TRUE
> ## actually everywhere, because of ATLAS, openBLAS, MKL, Intel... :
> iR2 <- setdiff(names(cobsL), nR2 <- c("cp2IC", "cp2i"))
> ## IGNORE_RDIFF_BEGIN
> dput(signif(gotRsqrs, digits=8))
c(c1 = 0.95341697, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
c2 = 0.94864721, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
cp2 = 0.94988863, cp2IC = 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487
)
> all.equal(Rsqrs[iR2], gotRsqrs[iR2], tolerance=0)# 2.6277e-9 (Lnx F 38); 2.6898e-9 (M1 mac)
[1] "Mean relative difference: 0.000374227"
> all.equal(Rsqrs[nR2], gotRsqrs[nR2], tolerance=0)# differ; drastically only for 'noLD'
[1] "Mean relative difference: 2.18514e-09"
> ## IGNORE_RDIFF_END
> stopifnot(exprs = {
+ all.equal(Rsqrs[iR2], gotRsqrs[iR2])
+ identical(c(5L, 3L, 3L, 5L,
+ 3L, 2L, 3L, 4L,
+ 5L, 3L, 3L, 5L,
+ 4L, 2L, 2L, 4L), unname(lengths(knL)))
+ })
Error: Rsqrs[iR2] and gotRsqrs[iR2] are not equal:
Mean relative difference: 0.000374227
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc
Version: 1.3-8
Check: tests
Result: ERROR
Running '0_pt-ex.R' [2s]
Running 'ex1.R' [6s]
Running 'ex2-long.R' [6s]
Running 'ex3.R' [2s]
Comparing 'ex3.Rout' to 'ex3.Rout.save' ...15,16c15,16
< Warning messages:
< 1: In cobs(weight, height, knots = weight, nknots = length(weight)) :
---
> Warning message:
> In cobs(weight, height, knots = weight, nknots = length(weight)) :
19,20d18
< 2: In cobs(weight, height, knots = weight, nknots = length(weight)) :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running 'multi-constr.R' [3s]
Running 'roof.R' [3s]
Comparing 'roof.Rout' to 'roof.Rout.save' ... OK
Running 'small-ex.R' [2s]
Comparing 'small-ex.Rout' to 'small-ex.Rout.save' ...24,25d23
< Warning message:
< In cobs(x, y) : drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running 'spline-ex.R' [2s]
Comparing 'spline-ex.Rout' to 'spline-ex.Rout.save' ... OK
Running 'temp.R' [3s]
Comparing 'temp.Rout' to 'temp.Rout.save' ...445,446d444
< Warning in cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
456,457d453
< Warning in cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
463,464c459,460
< coef[1:5]: -0.39324840, -0.28115087, 0.05916295, -0.07465159, 0.31227753
< R^2 = 73.22% ; empirical tau (over all): 63/113 = 0.5575221 (target tau= 0.5)
---
> coef[1:5]: -0.40655906, -0.31473700, 0.05651823, -0.05681818, 0.28681956
> R^2 = 72.56% ; empirical tau (over all): 54/113 = 0.4778761 (target tau= 0.5)
470,473d465
<
< **** ERROR in algorithm: ifl = 18
<
<
476,478d467
< Warning message:
< In cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
481,482d469
< Warning in cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< The algorithm has not converged after 100 iterations
488,490c475
< [1] 1 2 9 10 17 18 20 21 22 23 26 27 35 36 42 47 48 49 52
< [20] 53 58 59 61 62 63 64 65 68 73 74 78 79 80 81 82 83 84 88
< [39] 90 91 94 98 100 101 102 104 108 109 111 112
---
> [1] 10 18 21 22 47 61 68 74 78 79 102 111
492,495c477
< [1] 3 4 5 6 7 8 11 12 13 14 15 16 19 24 25 28 29 30 31
< [20] 32 33 34 37 38 39 40 41 43 44 45 46 50 51 54 55 56 57 60
< [39] 66 67 69 70 71 72 75 76 77 85 86 87 89 92 93 95 96 97 99
< [58] 103 105 106 107 110 113
---
> [1] 5 8 25 38 39 50 54 77 85 97 113
Running 'wind.R' [8s]
Running the tests in 'tests/multi-constr.R' failed.
Complete output:
> #### Examples which use the new feature of more than one 'constraint'.
>
> suppressMessages(library(cobs))
>
> ## do *not* show platform info here (as have *.Rout.save), but in 0_pt-ex.R
> options(digits = 6)
>
> if(!dev.interactive(orNone=TRUE)) pdf("multi-constr.pdf")
>
> source(system.file("util.R", package = "cobs"))
> source(system.file(package="Matrix", "test-tools-1.R", mustWork=TRUE))
Loading required package: tools
> ##--> tryCatch.W.E(), showProc.time(), assertError(), relErrV(), ...
> Lnx <- Sys.info()[["sysname"]] == "Linux"
> isMac <- Sys.info()[["sysname"]] == "Darwin"
> x86 <- (arch <- Sys.info()[["machine"]]) == "x86_64"
> noLdbl <- (.Machine$sizeof.longdouble <= 8) ## TRUE when --disable-long-double
> ## IGNORE_RDIFF_BEGIN
> Sys.info()
sysname release version nodename machine
"Windows" "Server x64" "build 20348" "CRANWIN3" "x86-64"
login user effective_user udomain
"CRAN" "CRAN" "CRAN" "CRANWIN3"
> noLdbl
[1] FALSE
> ## IGNORE_RDIFF_END
>
>
> Rsq <- function(obj) {
+ stopifnot(inherits(obj, "cobs"), is.numeric(res <- obj$resid))
+ 1 - sum(res^2)/obj$SSy
+ }
> list_ <- function (...) `names<-`(list(...), vapply(sys.call()[-1L], as.character, ""))
> is.cobs <- function(x) inherits(x, "cobs")
>
> set.seed(908)
> x <- seq(-1,2, len = 50)
> f.true <- pnorm(2*x)
> y <- f.true + rnorm(50)/10
> plot(x,y); lines(x, f.true, col="gray", lwd=2, lty=3)
>
> ## constraint on derivative at right end:
> (con <- rbind(c(2 , max(x), 0))) # f'(x_n) == 0
[,1] [,2] [,3]
[1,] 2 2 0
>
> ## Using 'trace = 3' --> 'trace = 2' inside drqssbc2()
>
> ## Regression splines (lambda = 0)
> c2 <- cobs(x,y, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Warning message:
In cobs(x, y, trace = 3) :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> c2i <- cobs(x,y, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 5 x 6 (nz = 15 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 6 x 7 (nz = 18 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
> c2c <- cobs(x,y, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 5 x 7 (nz = 15 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
>
> c2IC <- cobs(x,y, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 5 x 4 (nz = 15 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 7 x 5 (nz = 21 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 9 x 6 (nz = 27 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 11 x 7 (nz = 33 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
> ## here, it's the same as just "i":
> all.equal(fitted(c2i), fitted(c2IC))
[1] "Mean relative difference: 0.0808156"
>
> c1 <- cobs(x,y, degree = 1, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Warning in cobs(x, y, degree = 1, trace = 3) :
The algorithm has not converged after 100 iterations
> c1i <- cobs(x,y, degree = 1, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 5 x 6 (nz = 10 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
> c1c <- cobs(x,y, degree = 1, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
>
> plot(c1)
> lines(predict(c1i), col="forest green")
> all.equal(fitted(c1), fitted(c1i), tol = 1e-9)# but not 1e-10
[1] "Mean relative difference: 0.0215671"
>
> ## now gives warning (not error):
> c1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 12 =^= 0.6%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 7 x 5 (nz = 17 =^= 0.49%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 9 x 6 (nz = 22 =^= 0.41%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> cp2 <- cobs(x,y, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 2 x 6 (nz = 6 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 2 x 7 (nz = 6 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
>
> ## Here, warning ".. 'ifl'.. " on *some* platforms (e.g. Windows 32bit) :
> r2i <- tryCatch.W.E( cobs(x,y, constraint = "increase", pointwise = con) )
qbsks2():
Performing general knot selection ...
Deleting unnecessary knots ...
> cp2i <- r2i$value
> ## IGNORE_RDIFF_BEGIN
> r2i$warning
NULL
> ## IGNORE_RDIFF_END
> ## when plotting it, we see that it gave a trivial constant!!
> cp2c <- cobs(x,y, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 4 x 4 (nz = 12 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 5 x 5 (nz = 15 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 6 x 6 (nz = 18 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 7 x 7 (nz = 21 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
>
> ## now gives warning (not error): but no warning on M1 mac -> IGNORE
> ## IGNORE_RDIFF_BEGIN
> cp2IC <- cobs(x,y, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 7 x 4 (nz = 21 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 9 x 5 (nz = 27 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 11 x 6 (nz = 33 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 13 x 7 (nz = 39 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
Warning message:
In cobs(x, y, constraint = c("inc", "concave"), pointwise = con, :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> ## IGNORE_RDIFF_END
> cp1 <- cobs(x,y, degree = 1, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 2 x 6 (nz = 4 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
> cp1i <- cobs(x,y, degree = 1, constraint = "increase", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 4 x 3 (nz = 8 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 7 x 6 (nz = 14 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
> cp1c <- cobs(x,y, degree = 1, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 4 x 4 (nz = 10 =^= 0.62%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 5 x 5 (nz = 13 =^= 0.52%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 6 x 6 (nz = 16 =^= 0.44%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
>
> cp1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 7 x 4 (nz = 16 =^= 0.57%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 9 x 5 (nz = 21 =^= 0.47%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 11 x 6 (nz = 26 =^= 0.39%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> ## Named list of all cobs() results above -- sort() collation order matters for ls() !
> (curLC <- Sys.getlocale("LC_COLLATE"))
[1] "C"
> Sys.setlocale("LC_COLLATE", "C")
[1] "C"
> cobsL <- mget(Filter(\(nm) is.cobs(.GlobalEnv[[nm]]), ls(patt="c[12p]")),
+ envir = .GlobalEnv)
> Sys.setlocale("LC_COLLATE", curLC) # reverting
[1] "C"
>
> knL <- lapply(cobsL, `[[`, "knots")
> str(knL[order(lengths(knL))])
List of 16
$ c2IC : num [1:2] -1 2
$ cp2IC: num [1:2] -1 2
$ cp2c : num [1:2] -1 2
$ c1IC : num [1:3] -1 0.776 2
$ c1c : num [1:3] -1 0.776 2
$ c2 : num [1:3] -1 -0.449 2
$ c2c : num [1:3] -1 0.163 2
$ cp1IC: num [1:3] -1 0.776 2
$ cp1c : num [1:3] -1 0.776 2
$ c2i : num [1:4] -1 0.163 0.776 2
$ cp2 : num [1:4] -1 -0.449 0.776 2
$ cp2i : num [1:4] -1 0.163 0.776 2
$ c1 : num [1:5] -1 -0.449 0.163 0.776 2
$ c1i : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1 : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1i : num [1:5] -1 -0.449 0.163 0.776 2
>
> gotRsqrs <- sapply(cobsL, Rsq)
> Rsqrs <- c(c1 = 0.95079126, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
+ c2 = 0.94637437, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
+ cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
+ cp2 = 0.94988863, cp2IC= 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487)
> ## M1 mac " = " , cp2IC= 0.91704726, " = " , cp2i = 0.94620178
> ## noLD " = " , cp2IC=-0.08244284, " = " , cp2i = 0.94636815
> ## ATLAS " = " , cp2IC= 0.91471729, " = " , cp2i = 0.94506339
> ## openBLAS " = " , cp2IC= 0.91738019, " = " , cp2i = 0.93589404
> ## MKL " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## Intel " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## ^^^^^^^^^^ ^^^^^^^^^^
> ## remove these two from testing, notably for the M1 Mac & noLD .. :
> ##iR2 <- if(!x86 || noLdbl) setdiff(names(cobsL), c("cp2IC", "cp2i")) else TRUE
> ## actually everywhere, because of ATLAS, openBLAS, MKL, Intel... :
> iR2 <- setdiff(names(cobsL), nR2 <- c("cp2IC", "cp2i"))
> ## IGNORE_RDIFF_BEGIN
> dput(signif(gotRsqrs, digits=8))
c(c1 = 0.95341697, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
c2 = 0.94864721, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
cp2 = 0.94988863, cp2IC = 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487
)
> all.equal(Rsqrs[iR2], gotRsqrs[iR2], tolerance=0)# 2.6277e-9 (Lnx F 38); 2.6898e-9 (M1 mac)
[1] "Mean relative difference: 0.000374227"
> all.equal(Rsqrs[nR2], gotRsqrs[nR2], tolerance=0)# differ; drastically only for 'noLD'
[1] "Mean relative difference: 2.18514e-09"
> ## IGNORE_RDIFF_END
> stopifnot(exprs = {
+ all.equal(Rsqrs[iR2], gotRsqrs[iR2])
+ identical(c(5L, 3L, 3L, 5L,
+ 3L, 2L, 3L, 4L,
+ 5L, 3L, 3L, 5L,
+ 4L, 2L, 2L, 4L), unname(lengths(knL)))
+ })
Error: Rsqrs[iR2] and gotRsqrs[iR2] are not equal:
Mean relative difference: 0.000374227
Execution halted
Flavor: r-devel-windows-x86_64
Version: 1.3-8
Check: tests
Result: ERROR
Running ‘0_pt-ex.R’ [2s/3s]
Running ‘ex1.R’ [7s/8s]
Running ‘ex2-long.R’ [7s/8s]
Running ‘ex3.R’ [2s/2s]
Comparing ‘ex3.Rout’ to ‘ex3.Rout.save’ ...15,16c15,16
< Warning messages:
< 1: In cobs(weight, height, knots = weight, nknots = length(weight)) :
---
> Warning message:
> In cobs(weight, height, knots = weight, nknots = length(weight)) :
19,20d18
< 2: In cobs(weight, height, knots = weight, nknots = length(weight)) :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘multi-constr.R’ [4s/5s]
Running ‘roof.R’ [4s/5s]
Comparing ‘roof.Rout’ to ‘roof.Rout.save’ ... OK
Running ‘small-ex.R’ [3s/4s]
Comparing ‘small-ex.Rout’ to ‘small-ex.Rout.save’ ...24,25d23
< Warning message:
< In cobs(x, y) : drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running ‘spline-ex.R’ [2s/3s]
Comparing ‘spline-ex.Rout’ to ‘spline-ex.Rout.save’ ... OK
Running ‘temp.R’ [3s/4s]
Comparing ‘temp.Rout’ to ‘temp.Rout.save’ ...445,446d444
< Warning in cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
456,457d453
< Warning in cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
463,464c459,460
< coef[1:5]: -0.39324840, -0.28115087, 0.05916295, -0.07465159, 0.31227753
< R^2 = 73.22% ; empirical tau (over all): 63/113 = 0.5575221 (target tau= 0.5)
---
> coef[1:5]: -0.40655906, -0.31473700, 0.05651823, -0.05681818, 0.28681956
> R^2 = 72.56% ; empirical tau (over all): 54/113 = 0.4778761 (target tau= 0.5)
470,473d465
<
< **** ERROR in algorithm: ifl = 18
<
<
476,478d467
< Warning message:
< In cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
481,482d469
< Warning in cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< The algorithm has not converged after 100 iterations
488,490c475
< [1] 1 2 9 10 17 18 20 21 22 23 26 27 35 36 42 47 48 49 52
< [20] 53 58 59 61 62 63 64 65 68 73 74 78 79 80 81 82 83 84 88
< [39] 90 91 94 98 100 101 102 104 108 109 111 112
---
> [1] 10 18 21 22 47 61 68 74 78 79 102 111
492,495c477
< [1] 3 4 5 6 7 8 11 12 13 14 15 16 19 24 25 28 29 30 31
< [20] 32 33 34 37 38 39 40 41 43 44 45 46 50 51 54 55 56 57 60
< [39] 66 67 69 70 71 72 75 76 77 85 86 87 89 92 93 95 96 97 99
< [58] 103 105 106 107 110 113
---
> [1] 5 8 25 38 39 50 54 77 85 97 113
Running ‘wind.R’ [8s/9s]
Running the tests in ‘tests/multi-constr.R’ failed.
Complete output:
> #### Examples which use the new feature of more than one 'constraint'.
>
> suppressMessages(library(cobs))
>
> ## do *not* show platform info here (as have *.Rout.save), but in 0_pt-ex.R
> options(digits = 6)
>
> if(!dev.interactive(orNone=TRUE)) pdf("multi-constr.pdf")
>
> source(system.file("util.R", package = "cobs"))
> source(system.file(package="Matrix", "test-tools-1.R", mustWork=TRUE))
Loading required package: tools
> ##--> tryCatch.W.E(), showProc.time(), assertError(), relErrV(), ...
> Lnx <- Sys.info()[["sysname"]] == "Linux"
> isMac <- Sys.info()[["sysname"]] == "Darwin"
> x86 <- (arch <- Sys.info()[["machine"]]) == "x86_64"
> noLdbl <- (.Machine$sizeof.longdouble <= 8) ## TRUE when --disable-long-double
> ## IGNORE_RDIFF_BEGIN
> Sys.info()
sysname
"Linux"
release
"6.10.11-amd64"
version
"#1 SMP PREEMPT_DYNAMIC Debian 6.10.11-1 (2024-09-22)"
nodename
"gimli2"
machine
"x86_64"
login
"hornik"
user
"hornik"
effective_user
"hornik"
> noLdbl
[1] FALSE
> ## IGNORE_RDIFF_END
>
>
> Rsq <- function(obj) {
+ stopifnot(inherits(obj, "cobs"), is.numeric(res <- obj$resid))
+ 1 - sum(res^2)/obj$SSy
+ }
> list_ <- function (...) `names<-`(list(...), vapply(sys.call()[-1L], as.character, ""))
> is.cobs <- function(x) inherits(x, "cobs")
>
> set.seed(908)
> x <- seq(-1,2, len = 50)
> f.true <- pnorm(2*x)
> y <- f.true + rnorm(50)/10
> plot(x,y); lines(x, f.true, col="gray", lwd=2, lty=3)
>
> ## constraint on derivative at right end:
> (con <- rbind(c(2 , max(x), 0))) # f'(x_n) == 0
[,1] [,2] [,3]
[1,] 2 2 0
>
> ## Using 'trace = 3' --> 'trace = 2' inside drqssbc2()
>
> ## Regression splines (lambda = 0)
> c2 <- cobs(x,y, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Warning message:
In cobs(x, y, trace = 3) :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> c2i <- cobs(x,y, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 5 x 6 (nz = 15 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 6 x 7 (nz = 18 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
> c2c <- cobs(x,y, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 5 x 7 (nz = 15 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
>
> c2IC <- cobs(x,y, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 5 x 4 (nz = 15 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 7 x 5 (nz = 21 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 9 x 6 (nz = 27 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 11 x 7 (nz = 33 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
> ## here, it's the same as just "i":
> all.equal(fitted(c2i), fitted(c2IC))
[1] "Mean relative difference: 0.0808156"
>
> c1 <- cobs(x,y, degree = 1, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Warning in cobs(x, y, degree = 1, trace = 3) :
The algorithm has not converged after 100 iterations
> c1i <- cobs(x,y, degree = 1, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 5 x 6 (nz = 10 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
> c1c <- cobs(x,y, degree = 1, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
>
> plot(c1)
> lines(predict(c1i), col="forest green")
> all.equal(fitted(c1), fitted(c1i), tol = 1e-9)# but not 1e-10
[1] "Mean relative difference: 0.0215671"
>
> ## now gives warning (not error):
> c1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 12 =^= 0.6%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 7 x 5 (nz = 17 =^= 0.49%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 9 x 6 (nz = 22 =^= 0.41%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> cp2 <- cobs(x,y, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 2 x 6 (nz = 6 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 2 x 7 (nz = 6 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
>
> ## Here, warning ".. 'ifl'.. " on *some* platforms (e.g. Windows 32bit) :
> r2i <- tryCatch.W.E( cobs(x,y, constraint = "increase", pointwise = con) )
qbsks2():
Performing general knot selection ...
Deleting unnecessary knots ...
> cp2i <- r2i$value
> ## IGNORE_RDIFF_BEGIN
> r2i$warning
NULL
> ## IGNORE_RDIFF_END
> ## when plotting it, we see that it gave a trivial constant!!
> cp2c <- cobs(x,y, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 4 x 4 (nz = 12 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 5 x 5 (nz = 15 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 6 x 6 (nz = 18 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 7 x 7 (nz = 21 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
>
> ## now gives warning (not error): but no warning on M1 mac -> IGNORE
> ## IGNORE_RDIFF_BEGIN
> cp2IC <- cobs(x,y, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 7 x 4 (nz = 21 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 9 x 5 (nz = 27 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 11 x 6 (nz = 33 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 13 x 7 (nz = 39 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
Warning message:
In cobs(x, y, constraint = c("inc", "concave"), pointwise = con, :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> ## IGNORE_RDIFF_END
> cp1 <- cobs(x,y, degree = 1, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 2 x 6 (nz = 4 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
> cp1i <- cobs(x,y, degree = 1, constraint = "increase", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 4 x 3 (nz = 8 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 7 x 6 (nz = 14 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
> cp1c <- cobs(x,y, degree = 1, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 4 x 4 (nz = 10 =^= 0.62%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 5 x 5 (nz = 13 =^= 0.52%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 6 x 6 (nz = 16 =^= 0.44%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
>
> cp1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 7 x 4 (nz = 16 =^= 0.57%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 9 x 5 (nz = 21 =^= 0.47%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 11 x 6 (nz = 26 =^= 0.39%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> ## Named list of all cobs() results above -- sort() collation order matters for ls() !
> (curLC <- Sys.getlocale("LC_COLLATE"))
[1] "C"
> Sys.setlocale("LC_COLLATE", "C")
[1] "C"
> cobsL <- mget(Filter(\(nm) is.cobs(.GlobalEnv[[nm]]), ls(patt="c[12p]")),
+ envir = .GlobalEnv)
> Sys.setlocale("LC_COLLATE", curLC) # reverting
[1] "C"
>
> knL <- lapply(cobsL, `[[`, "knots")
> str(knL[order(lengths(knL))])
List of 16
$ c2IC : num [1:2] -1 2
$ cp2IC: num [1:2] -1 2
$ cp2c : num [1:2] -1 2
$ c1IC : num [1:3] -1 0.776 2
$ c1c : num [1:3] -1 0.776 2
$ c2 : num [1:3] -1 -0.449 2
$ c2c : num [1:3] -1 0.163 2
$ cp1IC: num [1:3] -1 0.776 2
$ cp1c : num [1:3] -1 0.776 2
$ c2i : num [1:4] -1 0.163 0.776 2
$ cp2 : num [1:4] -1 -0.449 0.776 2
$ cp2i : num [1:4] -1 0.163 0.776 2
$ c1 : num [1:5] -1 -0.449 0.163 0.776 2
$ c1i : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1 : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1i : num [1:5] -1 -0.449 0.163 0.776 2
>
> gotRsqrs <- sapply(cobsL, Rsq)
> Rsqrs <- c(c1 = 0.95079126, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
+ c2 = 0.94637437, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
+ cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
+ cp2 = 0.94988863, cp2IC= 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487)
> ## M1 mac " = " , cp2IC= 0.91704726, " = " , cp2i = 0.94620178
> ## noLD " = " , cp2IC=-0.08244284, " = " , cp2i = 0.94636815
> ## ATLAS " = " , cp2IC= 0.91471729, " = " , cp2i = 0.94506339
> ## openBLAS " = " , cp2IC= 0.91738019, " = " , cp2i = 0.93589404
> ## MKL " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## Intel " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## ^^^^^^^^^^ ^^^^^^^^^^
> ## remove these two from testing, notably for the M1 Mac & noLD .. :
> ##iR2 <- if(!x86 || noLdbl) setdiff(names(cobsL), c("cp2IC", "cp2i")) else TRUE
> ## actually everywhere, because of ATLAS, openBLAS, MKL, Intel... :
> iR2 <- setdiff(names(cobsL), nR2 <- c("cp2IC", "cp2i"))
> ## IGNORE_RDIFF_BEGIN
> dput(signif(gotRsqrs, digits=8))
c(c1 = 0.95341697, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
c2 = 0.94864721, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
cp2 = 0.94988863, cp2IC = 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487
)
> all.equal(Rsqrs[iR2], gotRsqrs[iR2], tolerance=0)# 2.6277e-9 (Lnx F 38); 2.6898e-9 (M1 mac)
[1] "Mean relative difference: 0.000374227"
> all.equal(Rsqrs[nR2], gotRsqrs[nR2], tolerance=0)# differ; drastically only for 'noLD'
[1] "Mean relative difference: 2.18514e-09"
> ## IGNORE_RDIFF_END
> stopifnot(exprs = {
+ all.equal(Rsqrs[iR2], gotRsqrs[iR2])
+ identical(c(5L, 3L, 3L, 5L,
+ 3L, 2L, 3L, 4L,
+ 5L, 3L, 3L, 5L,
+ 4L, 2L, 2L, 4L), unname(lengths(knL)))
+ })
Error: Rsqrs[iR2] and gotRsqrs[iR2] are not equal:
Mean relative difference: 0.000374227
Execution halted
Flavor: r-patched-linux-x86_64
Version: 1.3-8
Check: tests
Result: ERROR
Running '0_pt-ex.R' [2s]
Running 'ex1.R' [6s]
Running 'ex2-long.R' [6s]
Running 'ex3.R' [2s]
Comparing 'ex3.Rout' to 'ex3.Rout.save' ...15,16c15,16
< Warning messages:
< 1: In cobs(weight, height, knots = weight, nknots = length(weight)) :
---
> Warning message:
> In cobs(weight, height, knots = weight, nknots = length(weight)) :
19,20d18
< 2: In cobs(weight, height, knots = weight, nknots = length(weight)) :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running 'multi-constr.R' [3s]
Running 'roof.R' [3s]
Comparing 'roof.Rout' to 'roof.Rout.save' ... OK
Running 'small-ex.R' [2s]
Comparing 'small-ex.Rout' to 'small-ex.Rout.save' ...24,25d23
< Warning message:
< In cobs(x, y) : drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running 'spline-ex.R' [2s]
Comparing 'spline-ex.Rout' to 'spline-ex.Rout.save' ... OK
Running 'temp.R' [3s]
Comparing 'temp.Rout' to 'temp.Rout.save' ...445,446d444
< Warning in cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
456,457d453
< Warning in cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
463,464c459,460
< coef[1:5]: -0.39324840, -0.28115087, 0.05916295, -0.07465159, 0.31227753
< R^2 = 73.22% ; empirical tau (over all): 63/113 = 0.5575221 (target tau= 0.5)
---
> coef[1:5]: -0.40655906, -0.31473700, 0.05651823, -0.05681818, 0.28681956
> R^2 = 72.56% ; empirical tau (over all): 54/113 = 0.4778761 (target tau= 0.5)
470,473d465
<
< **** ERROR in algorithm: ifl = 18
<
<
476,478d467
< Warning message:
< In cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
481,482d469
< Warning in cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< The algorithm has not converged after 100 iterations
488,490c475
< [1] 1 2 9 10 17 18 20 21 22 23 26 27 35 36 42 47 48 49 52
< [20] 53 58 59 61 62 63 64 65 68 73 74 78 79 80 81 82 83 84 88
< [39] 90 91 94 98 100 101 102 104 108 109 111 112
---
> [1] 10 18 21 22 47 61 68 74 78 79 102 111
492,495c477
< [1] 3 4 5 6 7 8 11 12 13 14 15 16 19 24 25 28 29 30 31
< [20] 32 33 34 37 38 39 40 41 43 44 45 46 50 51 54 55 56 57 60
< [39] 66 67 69 70 71 72 75 76 77 85 86 87 89 92 93 95 96 97 99
< [58] 103 105 106 107 110 113
---
> [1] 5 8 25 38 39 50 54 77 85 97 113
Running 'wind.R' [8s]
Running the tests in 'tests/multi-constr.R' failed.
Complete output:
> #### Examples which use the new feature of more than one 'constraint'.
>
> suppressMessages(library(cobs))
>
> ## do *not* show platform info here (as have *.Rout.save), but in 0_pt-ex.R
> options(digits = 6)
>
> if(!dev.interactive(orNone=TRUE)) pdf("multi-constr.pdf")
>
> source(system.file("util.R", package = "cobs"))
> source(system.file(package="Matrix", "test-tools-1.R", mustWork=TRUE))
Loading required package: tools
> ##--> tryCatch.W.E(), showProc.time(), assertError(), relErrV(), ...
> Lnx <- Sys.info()[["sysname"]] == "Linux"
> isMac <- Sys.info()[["sysname"]] == "Darwin"
> x86 <- (arch <- Sys.info()[["machine"]]) == "x86_64"
> noLdbl <- (.Machine$sizeof.longdouble <= 8) ## TRUE when --disable-long-double
> ## IGNORE_RDIFF_BEGIN
> Sys.info()
sysname release version nodename machine
"Windows" "Server x64" "build 20348" "CRANWIN3" "x86-64"
login user effective_user
"CRAN" "CRAN" "CRAN"
> noLdbl
[1] FALSE
> ## IGNORE_RDIFF_END
>
>
> Rsq <- function(obj) {
+ stopifnot(inherits(obj, "cobs"), is.numeric(res <- obj$resid))
+ 1 - sum(res^2)/obj$SSy
+ }
> list_ <- function (...) `names<-`(list(...), vapply(sys.call()[-1L], as.character, ""))
> is.cobs <- function(x) inherits(x, "cobs")
>
> set.seed(908)
> x <- seq(-1,2, len = 50)
> f.true <- pnorm(2*x)
> y <- f.true + rnorm(50)/10
> plot(x,y); lines(x, f.true, col="gray", lwd=2, lty=3)
>
> ## constraint on derivative at right end:
> (con <- rbind(c(2 , max(x), 0))) # f'(x_n) == 0
[,1] [,2] [,3]
[1,] 2 2 0
>
> ## Using 'trace = 3' --> 'trace = 2' inside drqssbc2()
>
> ## Regression splines (lambda = 0)
> c2 <- cobs(x,y, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Warning message:
In cobs(x, y, trace = 3) :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> c2i <- cobs(x,y, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 5 x 6 (nz = 15 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 6 x 7 (nz = 18 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
> c2c <- cobs(x,y, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 5 x 7 (nz = 15 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
>
> c2IC <- cobs(x,y, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 5 x 4 (nz = 15 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 7 x 5 (nz = 21 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 9 x 6 (nz = 27 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 11 x 7 (nz = 33 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
> ## here, it's the same as just "i":
> all.equal(fitted(c2i), fitted(c2IC))
[1] "Mean relative difference: 0.0808156"
>
> c1 <- cobs(x,y, degree = 1, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Warning in cobs(x, y, degree = 1, trace = 3) :
The algorithm has not converged after 100 iterations
> c1i <- cobs(x,y, degree = 1, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 5 x 6 (nz = 10 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
> c1c <- cobs(x,y, degree = 1, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
>
> plot(c1)
> lines(predict(c1i), col="forest green")
> all.equal(fitted(c1), fitted(c1i), tol = 1e-9)# but not 1e-10
[1] "Mean relative difference: 0.0215671"
>
> ## now gives warning (not error):
> c1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 12 =^= 0.6%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 7 x 5 (nz = 17 =^= 0.49%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 9 x 6 (nz = 22 =^= 0.41%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> cp2 <- cobs(x,y, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 2 x 6 (nz = 6 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 2 x 7 (nz = 6 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
>
> ## Here, warning ".. 'ifl'.. " on *some* platforms (e.g. Windows 32bit) :
> r2i <- tryCatch.W.E( cobs(x,y, constraint = "increase", pointwise = con) )
qbsks2():
Performing general knot selection ...
Deleting unnecessary knots ...
> cp2i <- r2i$value
> ## IGNORE_RDIFF_BEGIN
> r2i$warning
NULL
> ## IGNORE_RDIFF_END
> ## when plotting it, we see that it gave a trivial constant!!
> cp2c <- cobs(x,y, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 4 x 4 (nz = 12 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 5 x 5 (nz = 15 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 6 x 6 (nz = 18 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 7 x 7 (nz = 21 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
>
> ## now gives warning (not error): but no warning on M1 mac -> IGNORE
> ## IGNORE_RDIFF_BEGIN
> cp2IC <- cobs(x,y, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 7 x 4 (nz = 21 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 9 x 5 (nz = 27 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 11 x 6 (nz = 33 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 13 x 7 (nz = 39 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
Warning message:
In cobs(x, y, constraint = c("inc", "concave"), pointwise = con, :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> ## IGNORE_RDIFF_END
> cp1 <- cobs(x,y, degree = 1, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 2 x 6 (nz = 4 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
> cp1i <- cobs(x,y, degree = 1, constraint = "increase", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 4 x 3 (nz = 8 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 7 x 6 (nz = 14 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
> cp1c <- cobs(x,y, degree = 1, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 4 x 4 (nz = 10 =^= 0.62%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 5 x 5 (nz = 13 =^= 0.52%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 6 x 6 (nz = 16 =^= 0.44%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
>
> cp1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 7 x 4 (nz = 16 =^= 0.57%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 9 x 5 (nz = 21 =^= 0.47%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 11 x 6 (nz = 26 =^= 0.39%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> ## Named list of all cobs() results above -- sort() collation order matters for ls() !
> (curLC <- Sys.getlocale("LC_COLLATE"))
[1] "C"
> Sys.setlocale("LC_COLLATE", "C")
[1] "C"
> cobsL <- mget(Filter(\(nm) is.cobs(.GlobalEnv[[nm]]), ls(patt="c[12p]")),
+ envir = .GlobalEnv)
> Sys.setlocale("LC_COLLATE", curLC) # reverting
[1] "C"
>
> knL <- lapply(cobsL, `[[`, "knots")
> str(knL[order(lengths(knL))])
List of 16
$ c2IC : num [1:2] -1 2
$ cp2IC: num [1:2] -1 2
$ cp2c : num [1:2] -1 2
$ c1IC : num [1:3] -1 0.776 2
$ c1c : num [1:3] -1 0.776 2
$ c2 : num [1:3] -1 -0.449 2
$ c2c : num [1:3] -1 0.163 2
$ cp1IC: num [1:3] -1 0.776 2
$ cp1c : num [1:3] -1 0.776 2
$ c2i : num [1:4] -1 0.163 0.776 2
$ cp2 : num [1:4] -1 -0.449 0.776 2
$ cp2i : num [1:4] -1 0.163 0.776 2
$ c1 : num [1:5] -1 -0.449 0.163 0.776 2
$ c1i : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1 : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1i : num [1:5] -1 -0.449 0.163 0.776 2
>
> gotRsqrs <- sapply(cobsL, Rsq)
> Rsqrs <- c(c1 = 0.95079126, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
+ c2 = 0.94637437, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
+ cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
+ cp2 = 0.94988863, cp2IC= 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487)
> ## M1 mac " = " , cp2IC= 0.91704726, " = " , cp2i = 0.94620178
> ## noLD " = " , cp2IC=-0.08244284, " = " , cp2i = 0.94636815
> ## ATLAS " = " , cp2IC= 0.91471729, " = " , cp2i = 0.94506339
> ## openBLAS " = " , cp2IC= 0.91738019, " = " , cp2i = 0.93589404
> ## MKL " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## Intel " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## ^^^^^^^^^^ ^^^^^^^^^^
> ## remove these two from testing, notably for the M1 Mac & noLD .. :
> ##iR2 <- if(!x86 || noLdbl) setdiff(names(cobsL), c("cp2IC", "cp2i")) else TRUE
> ## actually everywhere, because of ATLAS, openBLAS, MKL, Intel... :
> iR2 <- setdiff(names(cobsL), nR2 <- c("cp2IC", "cp2i"))
> ## IGNORE_RDIFF_BEGIN
> dput(signif(gotRsqrs, digits=8))
c(c1 = 0.95341697, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
c2 = 0.94864721, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
cp2 = 0.94988863, cp2IC = 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487
)
> all.equal(Rsqrs[iR2], gotRsqrs[iR2], tolerance=0)# 2.6277e-9 (Lnx F 38); 2.6898e-9 (M1 mac)
[1] "Mean relative difference: 0.000374227"
> all.equal(Rsqrs[nR2], gotRsqrs[nR2], tolerance=0)# differ; drastically only for 'noLD'
[1] "Mean relative difference: 2.18514e-09"
> ## IGNORE_RDIFF_END
> stopifnot(exprs = {
+ all.equal(Rsqrs[iR2], gotRsqrs[iR2])
+ identical(c(5L, 3L, 3L, 5L,
+ 3L, 2L, 3L, 4L,
+ 5L, 3L, 3L, 5L,
+ 4L, 2L, 2L, 4L), unname(lengths(knL)))
+ })
Error: Rsqrs[iR2] and gotRsqrs[iR2] are not equal:
Mean relative difference: 0.000374227
Execution halted
Flavor: r-release-windows-x86_64
Version: 1.3-8
Check: tests
Result: ERROR
Running '0_pt-ex.R' [3s]
Running 'ex1.R' [9s]
Running 'ex2-long.R' [8s]
Running 'ex3.R' [3s]
Comparing 'ex3.Rout' to 'ex3.Rout.save' ...15,16c15,16
< Warning messages:
< 1: In cobs(weight, height, knots = weight, nknots = length(weight)) :
---
> Warning message:
> In cobs(weight, height, knots = weight, nknots = length(weight)) :
19,20d18
< 2: In cobs(weight, height, knots = weight, nknots = length(weight)) :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running 'multi-constr.R' [5s]
Running 'roof.R' [5s]
Comparing 'roof.Rout' to 'roof.Rout.save' ... OK
Running 'small-ex.R' [3s]
Comparing 'small-ex.Rout' to 'small-ex.Rout.save' ...24,25d23
< Warning message:
< In cobs(x, y) : drqssbc2(): Not all flags are normal (== 1), ifl : 18
Running 'spline-ex.R' [3s]
Comparing 'spline-ex.Rout' to 'spline-ex.Rout.save' ... OK
Running 'temp.R' [4s]
Comparing 'temp.Rout' to 'temp.Rout.save' ...445,446d444
< Warning in cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
456,457d453
< Warning in cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1, constraint = "none", :
< The algorithm has not converged after 100 iterations
463,464c459,460
< coef[1:5]: -0.39324840, -0.28115087, 0.05916295, -0.07465159, 0.31227753
< R^2 = 73.22% ; empirical tau (over all): 63/113 = 0.5575221 (target tau= 0.5)
---
> coef[1:5]: -0.40655906, -0.31473700, 0.05651823, -0.05681818, 0.28681956
> R^2 = 72.56% ; empirical tau (over all): 54/113 = 0.4778761 (target tau= 0.5)
470,473d465
<
< **** ERROR in algorithm: ifl = 18
<
<
476,478d467
< Warning message:
< In cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< drqssbc2(): Not all flags are normal (== 1), ifl : 18
481,482d469
< Warning in cobs(year, temp, nknots = length(a50$knots), knots = a50$knot, :
< The algorithm has not converged after 100 iterations
488,490c475
< [1] 1 2 9 10 17 18 20 21 22 23 26 27 35 36 42 47 48 49 52
< [20] 53 58 59 61 62 63 64 65 68 73 74 78 79 80 81 82 83 84 88
< [39] 90 91 94 98 100 101 102 104 108 109 111 112
---
> [1] 10 18 21 22 47 61 68 74 78 79 102 111
492,495c477
< [1] 3 4 5 6 7 8 11 12 13 14 15 16 19 24 25 28 29 30 31
< [20] 32 33 34 37 38 39 40 41 43 44 45 46 50 51 54 55 56 57 60
< [39] 66 67 69 70 71 72 75 76 77 85 86 87 89 92 93 95 96 97 99
< [58] 103 105 106 107 110 113
---
> [1] 5 8 25 38 39 50 54 77 85 97 113
Running 'wind.R' [11s]
Running the tests in 'tests/multi-constr.R' failed.
Complete output:
> #### Examples which use the new feature of more than one 'constraint'.
>
> suppressMessages(library(cobs))
>
> ## do *not* show platform info here (as have *.Rout.save), but in 0_pt-ex.R
> options(digits = 6)
>
> if(!dev.interactive(orNone=TRUE)) pdf("multi-constr.pdf")
>
> source(system.file("util.R", package = "cobs"))
> source(system.file(package="Matrix", "test-tools-1.R", mustWork=TRUE))
Loading required package: tools
> ##--> tryCatch.W.E(), showProc.time(), assertError(), relErrV(), ...
> Lnx <- Sys.info()[["sysname"]] == "Linux"
> isMac <- Sys.info()[["sysname"]] == "Darwin"
> x86 <- (arch <- Sys.info()[["machine"]]) == "x86_64"
> noLdbl <- (.Machine$sizeof.longdouble <= 8) ## TRUE when --disable-long-double
> ## IGNORE_RDIFF_BEGIN
> Sys.info()
sysname release version nodename machine
"Windows" "Server x64" "build 20348" "CRANWIN2" "x86-64"
login user effective_user
"CRAN" "CRAN" "CRAN"
> noLdbl
[1] FALSE
> ## IGNORE_RDIFF_END
>
>
> Rsq <- function(obj) {
+ stopifnot(inherits(obj, "cobs"), is.numeric(res <- obj$resid))
+ 1 - sum(res^2)/obj$SSy
+ }
> list_ <- function (...) `names<-`(list(...), vapply(sys.call()[-1L], as.character, ""))
> is.cobs <- function(x) inherits(x, "cobs")
>
> set.seed(908)
> x <- seq(-1,2, len = 50)
> f.true <- pnorm(2*x)
> y <- f.true + rnorm(50)/10
> plot(x,y); lines(x, f.true, col="gray", lwd=2, lty=3)
>
> ## constraint on derivative at right end:
> (con <- rbind(c(2 , max(x), 0))) # f'(x_n) == 0
[,1] [,2] [,3]
[1,] 2 2 0
>
> ## Using 'trace = 3' --> 'trace = 2' inside drqssbc2()
>
> ## Regression splines (lambda = 0)
> c2 <- cobs(x,y, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Warning message:
In cobs(x, y, trace = 3) :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> c2i <- cobs(x,y, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 5 x 6 (nz = 15 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 6 x 7 (nz = 18 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 3 x 4 (nz = 9 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 4 x 5 (nz = 12 =^= 0.6%)
> c2c <- cobs(x,y, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 5 x 7 (nz = 15 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 1 x 3 (nz = 3 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
>
> c2IC <- cobs(x,y, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 5 x 4 (nz = 15 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 7 x 5 (nz = 21 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 9 x 6 (nz = 27 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 11 x 7 (nz = 33 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
> ## here, it's the same as just "i":
> all.equal(fitted(c2i), fitted(c2IC))
[1] "Mean relative difference: 0.0808156"
>
> c1 <- cobs(x,y, degree = 1, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Warning in cobs(x, y, degree = 1, trace = 3) :
The algorithm has not converged after 100 iterations
> c1i <- cobs(x,y, degree = 1, constraint = c("increase"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 5 x 6 (nz = 10 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 3 x 4 (nz = 6 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 4 x 5 (nz = 8 =^= 0.4%)
> c1c <- cobs(x,y, degree = 1, constraint = c("concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 3 x 5 (nz = 9 =^= 0.6%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 4 x 6 (nz = 12 =^= 0.5%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 1 x 3 (nz = 3 =^= 1%)
>
> plot(c1)
> lines(predict(c1i), col="forest green")
> all.equal(fitted(c1), fitted(c1i), tol = 1e-9)# but not 1e-10
[1] "Mean relative difference: 0.0215671"
>
> ## now gives warning (not error):
> c1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 12 =^= 0.6%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 7 x 5 (nz = 17 =^= 0.49%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 9 x 6 (nz = 22 =^= 0.41%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 1 x 2 (nz = 2 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> cp2 <- cobs(x,y, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 2 x 3 (nz = 6 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 2 x 6 (nz = 6 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 2 x 7 (nz = 6 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 2 x 4 (nz = 6 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 2 x 5 (nz = 6 =^= 0.6%)
>
> ## Here, warning ".. 'ifl'.. " on *some* platforms (e.g. Windows 32bit) :
> r2i <- tryCatch.W.E( cobs(x,y, constraint = "increase", pointwise = con) )
qbsks2():
Performing general knot selection ...
Deleting unnecessary knots ...
> cp2i <- r2i$value
> ## IGNORE_RDIFF_BEGIN
> r2i$warning
NULL
> ## IGNORE_RDIFF_END
> ## when plotting it, we see that it gave a trivial constant!!
> cp2c <- cobs(x,y, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 4 x 4 (nz = 12 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 5 x 5 (nz = 15 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 6 x 6 (nz = 18 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 7 x 7 (nz = 21 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 3 x 3 (nz = 9 =^= 1%)
>
> ## now gives warning (not error): but no warning on M1 mac -> IGNORE
> ## IGNORE_RDIFF_BEGIN
> cp2IC <- cobs(x,y, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
loo.design2(): -> Xeq 50 x 4 (nz = 150 =^= 0.75%)
Xieq 7 x 4 (nz = 21 =^= 0.75%)
loo.design2(): -> Xeq 50 x 5 (nz = 150 =^= 0.6%)
Xieq 9 x 5 (nz = 27 =^= 0.6%)
loo.design2(): -> Xeq 50 x 6 (nz = 150 =^= 0.5%)
Xieq 11 x 6 (nz = 33 =^= 0.5%)
loo.design2(): -> Xeq 50 x 7 (nz = 150 =^= 0.43%)
Xieq 13 x 7 (nz = 39 =^= 0.43%)
Deleting unnecessary knots ...
loo.design2(): -> Xeq 50 x 3 (nz = 150 =^= 1%)
Xieq 5 x 3 (nz = 15 =^= 1%)
Warning message:
In cobs(x, y, constraint = c("inc", "concave"), pointwise = con, :
drqssbc2(): Not all flags are normal (== 1), ifl : 18
> ## IGNORE_RDIFF_END
> cp1 <- cobs(x,y, degree = 1, pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 2 x 3 (nz = 4 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 2 x 6 (nz = 4 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 2 x 4 (nz = 4 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 2 x 5 (nz = 4 =^= 0.4%)
> cp1i <- cobs(x,y, degree = 1, constraint = "increase", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 4 x 3 (nz = 8 =^= 0.67%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 7 x 6 (nz = 14 =^= 0.33%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 5 x 4 (nz = 10 =^= 0.5%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 6 x 5 (nz = 12 =^= 0.4%)
> cp1c <- cobs(x,y, degree = 1, constraint = "concave", pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 4 x 4 (nz = 10 =^= 0.62%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 5 x 5 (nz = 13 =^= 0.52%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 6 x 6 (nz = 16 =^= 0.44%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 2 x 2 (nz = 4 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 3 x 3 (nz = 7 =^= 0.78%)
>
> cp1IC <- cobs(x,y, degree = 1, constraint = c("inc", "concave"), pointwise = con, trace = 3)
qbsks2():
Performing general knot selection ...
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 4 (nz = 100 =^= 0.5%)
Xieq 7 x 4 (nz = 16 =^= 0.57%)
l1.design2(): -> Xeq 50 x 5 (nz = 100 =^= 0.4%)
Xieq 9 x 5 (nz = 21 =^= 0.47%)
l1.design2(): -> Xeq 50 x 6 (nz = 100 =^= 0.33%)
Xieq 11 x 6 (nz = 26 =^= 0.39%)
Deleting unnecessary knots ...
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
l1.design2(): -> Xeq 50 x 2 (nz = 100 =^= 1%)
Xieq 3 x 2 (nz = 6 =^= 1%)
l1.design2(): -> Xeq 50 x 3 (nz = 100 =^= 0.67%)
Xieq 5 x 3 (nz = 11 =^= 0.73%)
Warning messages:
1: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
2: In l1.design2(x, w, constraint, ptConstr, knots, pw, nrq = n, nl1, :
too few knots ==> nk <= 4; could not add constraint 'concave'
>
> ## Named list of all cobs() results above -- sort() collation order matters for ls() !
> (curLC <- Sys.getlocale("LC_COLLATE"))
[1] "C"
> Sys.setlocale("LC_COLLATE", "C")
[1] "C"
> cobsL <- mget(Filter(\(nm) is.cobs(.GlobalEnv[[nm]]), ls(patt="c[12p]")),
+ envir = .GlobalEnv)
> Sys.setlocale("LC_COLLATE", curLC) # reverting
[1] "C"
>
> knL <- lapply(cobsL, `[[`, "knots")
> str(knL[order(lengths(knL))])
List of 16
$ c2IC : num [1:2] -1 2
$ cp2IC: num [1:2] -1 2
$ cp2c : num [1:2] -1 2
$ c1IC : num [1:3] -1 0.776 2
$ c1c : num [1:3] -1 0.776 2
$ c2 : num [1:3] -1 -0.449 2
$ c2c : num [1:3] -1 0.163 2
$ cp1IC: num [1:3] -1 0.776 2
$ cp1c : num [1:3] -1 0.776 2
$ c2i : num [1:4] -1 0.163 0.776 2
$ cp2 : num [1:4] -1 -0.449 0.776 2
$ cp2i : num [1:4] -1 0.163 0.776 2
$ c1 : num [1:5] -1 -0.449 0.163 0.776 2
$ c1i : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1 : num [1:5] -1 -0.449 0.163 0.776 2
$ cp1i : num [1:5] -1 -0.449 0.163 0.776 2
>
> gotRsqrs <- sapply(cobsL, Rsq)
> Rsqrs <- c(c1 = 0.95079126, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
+ c2 = 0.94637437, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
+ cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
+ cp2 = 0.94988863, cp2IC= 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487)
> ## M1 mac " = " , cp2IC= 0.91704726, " = " , cp2i = 0.94620178
> ## noLD " = " , cp2IC=-0.08244284, " = " , cp2i = 0.94636815
> ## ATLAS " = " , cp2IC= 0.91471729, " = " , cp2i = 0.94506339
> ## openBLAS " = " , cp2IC= 0.91738019, " = " , cp2i = 0.93589404
> ## MKL " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## Intel " = " , cp2IC= 0.91765403, " = " , cp2i = 0.94501205
> ## ^^^^^^^^^^ ^^^^^^^^^^
> ## remove these two from testing, notably for the M1 Mac & noLD .. :
> ##iR2 <- if(!x86 || noLdbl) setdiff(names(cobsL), c("cp2IC", "cp2i")) else TRUE
> ## actually everywhere, because of ATLAS, openBLAS, MKL, Intel... :
> iR2 <- setdiff(names(cobsL), nR2 <- c("cp2IC", "cp2i"))
> ## IGNORE_RDIFF_BEGIN
> dput(signif(gotRsqrs, digits=8))
c(c1 = 0.95341697, c1IC = 0.92974549, c1c = 0.92974549, c1i = 0.95079126,
c2 = 0.94864721, c2IC = 0.91375404, c2c = 0.92505977, c2i = 0.95022829,
cp1 = 0.9426453, cp1IC = 0.92223149, cp1c = 0.92223149, cp1i = 0.9426453,
cp2 = 0.94988863, cp2IC = 0.90051964, cp2c = 0.91375409, cp2i = 0.93611487
)
> all.equal(Rsqrs[iR2], gotRsqrs[iR2], tolerance=0)# 2.6277e-9 (Lnx F 38); 2.6898e-9 (M1 mac)
[1] "Mean relative difference: 0.000374227"
> all.equal(Rsqrs[nR2], gotRsqrs[nR2], tolerance=0)# differ; drastically only for 'noLD'
[1] "Mean relative difference: 2.18514e-09"
> ## IGNORE_RDIFF_END
> stopifnot(exprs = {
+ all.equal(Rsqrs[iR2], gotRsqrs[iR2])
+ identical(c(5L, 3L, 3L, 5L,
+ 3L, 2L, 3L, 4L,
+ 5L, 3L, 3L, 5L,
+ 4L, 2L, 2L, 4L), unname(lengths(knL)))
+ })
Error: Rsqrs[iR2] and gotRsqrs[iR2] are not equal:
Mean relative difference: 0.000374227
Execution halted
Flavor: r-oldrel-windows-x86_64