Last updated on 2025-07-08 07:51:01 CEST.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 2.1-10 | 127.01 | 276.79 | 403.80 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 2.1-10 | 89.45 | 169.91 | 259.36 | OK | |
| r-devel-linux-x86_64-fedora-clang | 2.1-10 | 742.05 | OK | |||
| r-devel-linux-x86_64-fedora-gcc | 2.1-10 | 673.94 | OK | |||
| r-devel-windows-x86_64 | 2.1-10 | 149.00 | 314.00 | 463.00 | OK | |
| r-patched-linux-x86_64 | 2.1-10 | 135.44 | 263.08 | 398.52 | OK | |
| r-release-linux-x86_64 | 2.1-10 | 126.29 | 261.72 | 388.01 | OK | |
| r-release-macos-arm64 | 2.1-10 | 213.00 | OK | |||
| r-release-macos-x86_64 | 2.1-10 | 351.00 | OK | |||
| r-release-windows-x86_64 | 2.1-10 | 152.00 | 313.00 | 465.00 | OK | |
| r-oldrel-macos-arm64 | 2.1-10 | 172.00 | NOTE | |||
| r-oldrel-macos-x86_64 | 2.1-10 | 305.00 | NOTE | |||
| r-oldrel-windows-x86_64 | 2.1-10 | 182.00 | 389.00 | 571.00 | OK |
Version: 2.1-10
Check: tests
Result: ERROR
Running ‘tests.R’ [1s/1s]
Running ‘testthat.R’ [181s/198s]
Running the tests in ‘tests/tests.R’ failed.
Complete output:
>
>
> require(stepR)
Loading required package: stepR
Successfully loaded stepR package version 2.1-10.
Several new functions are added in version 2.0-0. Some older functions are deprecated (still working) and may be defunct in a later version. Please read the documentation for more details.
> all.eq <- function(x, y, eps = 1e-5) TRUE #all(abs(x - y) < eps)
>
> # check Gauss var bounds
> # y <- c(-2:2, 4)
> y <- c(0, 2:5, 200, 7)
> quant <- 2
> # without penalty
> bs <- bounds.MRC(y, q = quant, family = "gaussvar", eps = 1e-5)
> b <- bs$bounds
> b
li ri lower upper
1 1 1 0.0000000 0.000000e+00
2 1 2 0.4439274 3.811767e+01
3 1 4 2.3043721 4.571412e+01
4 2 2 0.5766308 5.896390e+02
5 2 3 1.4427639 1.238824e+02
6 2 5 4.2908998 8.512284e+01
7 3 3 1.2974193 1.326688e+03
8 3 4 2.7745461 2.382355e+02
9 3 6 3182.4173844 6.313277e+04
10 4 4 2.3065233 2.358556e+03
11 4 5 4.5502555 3.907062e+02
12 4 7 3185.5958287 6.319582e+04
13 5 5 3.6039426 3.685244e+03
14 5 6 4442.0482273 3.814150e+05
15 6 6 5766.3081873 5.896390e+06
16 6 7 4444.7117915 3.816437e+05
17 7 7 7.0637275 7.223078e+03
> meanY2 <- sapply(1:nrow(b), function(i) mean(y[b$li[i]:b$ri[i]]^2))
> len <- b$ri - b$li + 1
> # len / 2 * ( -1 - log(meanY2 / b$lower) + meanY2 / b$lower ) - quant
> # len / 2 * ( -1 - log(meanY2 / b$upper) + meanY2 / b$upper ) - quant
> stopifnot(all(abs(ifelse(meanY2 == 0, b$lower, len / 2 * ( -1 - log(meanY2 / b$lower) + meanY2 / b$lower ) - quant)) < 1e-4 ))
> stopifnot(all(abs(ifelse(meanY2 == 0, b$upper, len / 2 * ( -1 - log(meanY2 / b$upper) + meanY2 / b$upper ) - quant)) < 1e-4 ))
> # check BoundGaussVar
> cand <- stepcand(y, family = "gaussvar")
> as.data.frame(cand)
leftEnd rightEnd value leftIndex rightIndex cumSumSq cumSumWe number improve
1 1 1 0 1 1 0 1 0 NA
2 2 2 4 2 2 4 2 0 NA
3 3 3 9 3 3 13 3 0 NA
4 4 4 16 4 4 29 4 0 NA
5 5 5 25 5 5 54 5 0 NA
6 6 6 40000 6 6 40054 6 0 NA
7 7 7 49 7 7 40103 7 0 NA
> bounded <- stepbound(cand, bs)
> as.data.frame(bounded)
leftEnd rightEnd value leftIndex rightIndex rightIndexLeftBound
1 1 1 0.000 1 1 1
2 2 5 13.500 2 5 5
3 6 7 7223.078 6 7 7
rightIndexRightBound rightEndLeftBound rightEndRightBound cumSumWe cumSumSq
1 1 1 1 1 0
2 5 5 5 5 54
3 7 7 7 7 40103
> # twice negative log-likelihood
> stopifnot(abs(attr(bounded, "cost") + sum(y != 0) * log(2 * pi) + 2 * sum(ifelse(fitted(bounded) == 0, ifelse(y ==0, 0, Inf), dnorm(y, 0, sqrt(fitted(bounded)), log = TRUE)))) < 1e-4 )
>
> # with log(length) penalty
> bs <- bounds.MRC(y, q = quant, family = "gaussvar", penalty = "len", eps = 1e-5)
> b <- bs$bounds
> b
li ri lower upper
1 1 1 0.0000000 0.000000e+00
2 1 2 0.3303939 1.385843e+02
3 1 4 2.0448560 6.318500e+01
4 2 2 0.3534120 2.908498e+04
5 2 3 1.0737803 4.503988e+02
6 2 5 3.8076628 1.176548e+02
7 3 3 0.7951770 6.544120e+04
8 3 4 2.0649622 8.661516e+02
9 3 6 2824.0165815 8.726066e+04
10 4 4 1.4136479 1.163399e+05
11 4 5 3.3865379 1.420489e+03
12 4 7 2826.8370724 8.734782e+04
13 5 5 2.2088249 1.817811e+05
14 5 6 3306.0044044 1.386709e+06
15 6 6 3534.1197894 2.908498e+08
16 6 7 3307.9867681 1.387540e+06
17 7 7 4.3292967 3.562910e+05
> meanY2 <- sapply(1:nrow(b), function(i) mean(y[b$li[i]:b$ri[i]]^2))
> len <- b$ri - b$li + 1
> # len / 2 * ( -1 - log(meanY2 / b$lower) + meanY2 / b$lower ) - quant
> # len / 2 * ( -1 - log(meanY2 / b$upper) + meanY2 / b$upper ) - quant
> stopifnot(all(abs(ifelse(meanY2 == 0, b$lower, len / 2 * ( -1 - log(meanY2 / b$lower) + meanY2 / b$lower ) - quant + log(len / length(y)) )) < 1e-4 ))
> stopifnot(all(abs(ifelse(meanY2 == 0, b$upper, len / 2 * ( -1 - log(meanY2 / b$upper) + meanY2 / b$upper ) - quant + log(len / length(y)) )) < 1e-4 ))
>
> # with sqrt penalty
> bs <- bounds.MRC(y, q = quant, family = "gaussvar", penalty = "sqrt", eps = 1e-15)
> b <- bs$bounds
> b
li ri lower upper
1 1 1 0.0000000 0.000000e+00
2 1 2 0.1669260 2.666428e+04
3 1 4 1.1323427 6.760178e+02
4 2 2 0.1682832 3.539826e+09
5 2 3 0.5425094 8.665890e+04
6 2 5 2.1085002 1.258792e+03
7 3 3 0.3786373 7.964609e+09
8 3 4 1.0432872 1.666517e+05
9 3 6 1563.8043081 9.336039e+05
10 4 4 0.6731329 1.415931e+10
11 4 5 1.7109911 2.733088e+05
12 4 7 1565.3661601 9.345364e+05
13 5 5 1.0517702 2.212391e+10
14 5 6 1670.3028831 2.668094e+08
15 6 6 1682.8323540 3.539826e+13
16 6 7 1671.3044389 2.669694e+08
17 7 7 2.0614696 4.336287e+10
> stopifnot(all(abs(ifelse(meanY2 == 0, b$lower, sqrt(2) * sqrt( len / 2 * ( -1 - log(meanY2 / b$lower) + meanY2 / b$lower ) ) - quant - sqrt(2*(1+log(length(y)/len))) )) < 1e-4 ))
> stopifnot(all(abs(ifelse(meanY2 == 0, b$upper, sqrt(2) * sqrt(len / 2 * ( -1 - log(meanY2 / b$upper) + meanY2 / b$upper )) - quant - sqrt(2*(1+log(length(y)/len))) )) < 1e-4 ))
>
> # check BoundGaussVar
> cand <- stepcand(y, family = "gaussvar")
> as.data.frame(cand)
leftEnd rightEnd value leftIndex rightIndex cumSumSq cumSumWe number improve
1 1 1 0 1 1 0 1 0 NA
2 2 2 4 2 2 4 2 0 NA
3 3 3 9 3 3 13 3 0 NA
4 4 4 16 4 4 29 4 0 NA
5 5 5 25 5 5 54 5 0 NA
6 6 6 40000 6 6 40054 6 0 NA
7 7 7 49 7 7 40103 7 0 NA
> bounded <- stepbound(cand, bs)
> as.data.frame(bounded)
leftEnd rightEnd value leftIndex rightIndex rightIndexLeftBound
1 1 1 0.0 1 1 1
2 2 5 13.5 2 5 2
3 6 7 20024.5 6 7 7
rightIndexRightBound rightEndLeftBound rightEndRightBound cumSumWe cumSumSq
1 1 1 1 1 0
2 5 2 5 5 54
3 7 7 7 7 40103
> # twice negative log-likelihood
> stopifnot(abs(attr(bounded, "cost") + sum(y != 0) * log(2 * pi) + 2 * sum(ifelse(fitted(bounded) == 0, ifelse(y ==0, 0, Inf), dnorm(y, 0, sqrt(fitted(bounded)), log = TRUE)))) < 1e-4 )
>
> # check Binomial bounds
> # y <- c(0, 0, 1, 2, 2)
> # size <- 2
> y <- c(0, 0, 1, 0, 1, 1, 1, 0)
> size <- 1
> quant <- 2
> # without penalty
> b <- bounds.MRC(y, q = quant, family = "binom", param = size, eps = 1e-5)$bounds
> b
li ri lower upper
1 1 1 0.00000000 0.8646647
2 1 2 0.00000000 0.6321206
3 1 4 0.01493266 0.7306796
4 1 8 0.18636433 0.8136357
5 2 2 0.00000000 0.8646647
6 2 3 0.03506325 0.9649367
7 2 5 0.10246995 0.8975300
8 3 3 0.13533528 1.0000000
9 3 4 0.03506325 0.9649367
10 3 6 0.26932042 0.9850673
11 4 4 0.00000000 0.8646647
12 4 5 0.03506325 0.9649367
13 4 7 0.26932042 0.9850673
14 5 5 0.13533528 1.0000000
15 5 6 0.36787944 1.0000000
16 5 8 0.26932042 0.9850673
17 6 6 0.13533528 1.0000000
18 6 7 0.36787944 1.0000000
19 7 7 0.13533528 1.0000000
20 7 8 0.03506325 0.9649367
21 8 8 0.00000000 0.8646647
> S <- sapply(1:nrow(b), function(i) sum(y[b$li[i]:b$ri[i]]))
> len <- b$ri - b$li + 1
> sizelen <- size * len
> NS <- sizelen - S
> stopifnot(all(ifelse(S == 0, b$lower, ifelse(NS == 0, -sizelen * log(b$lower), S * log(S / sizelen / b$lower) + NS * log(NS / sizelen / (1 - b$lower))) - quant) < 1e-4))
> stopifnot(all(ifelse(NS == 0, b$upper - 1, ifelse(S == 0, -sizelen * log(1 - b$upper), S * log(S / sizelen / b$upper) + NS * log(NS / sizelen / (1 - b$upper))) - quant) < 1e-4))
> # with len-penalty
> b <- bounds.MRC(y, q = quant, family = "binom", param = size, penalty = "len", eps = 1e-5)$bounds
> b
li ri lower upper
1 1 1 0.000000000 0.9830831
2 1 2 0.000000000 0.8160603
3 1 4 0.007295325 0.7918968
4 1 8 0.186364327 0.8136357
5 2 2 0.000000000 0.9830831
6 2 3 0.008531237 0.9914688
7 2 5 0.069921533 0.9300785
8 3 3 0.016916910 1.0000000
9 3 4 0.008531237 0.9914688
10 3 6 0.208103196 0.9927047
11 4 4 0.000000000 0.9830831
12 4 5 0.008531237 0.9914688
13 4 7 0.208103196 0.9927047
14 5 5 0.016916910 1.0000000
15 5 6 0.183939721 1.0000000
16 5 8 0.208103196 0.9927047
17 6 6 0.016916910 1.0000000
18 6 7 0.183939721 1.0000000
19 7 7 0.016916910 1.0000000
20 7 8 0.008531237 0.9914688
21 8 8 0.000000000 0.9830831
> S <- sapply(1:nrow(b), function(i) sum(y[b$li[i]:b$ri[i]]))
> len <- b$ri - b$li + 1
> sizelen <- size * len
> NS <- sizelen - S
> stopifnot(all(ifelse(S == 0, b$lower,abs( ifelse(NS == 0, -sizelen * log(b$lower), S * log(S / sizelen / b$lower) + NS * log(NS / sizelen / (1 - b$lower))) - quant + log(len / length(y)))) < 1e-4))
> stopifnot(all(ifelse(NS == 0, b$upper - 1, ifelse(S == 0, -sizelen * log(1 - b$upper), S * log(S / sizelen / b$upper) + NS * log(NS / sizelen / (1 - b$upper))) - quant + log(len / length(y))) < 1e-4))
> # with var-penalty
> b <- bounds.MRC(y, q = quant, family = "binom", param = size, penalty = "var", eps = 1e-5)$bounds
> b
li ri lower upper
1 1 2 0.0000000 0.8807971
2 1 4 0.0000000 0.8310406
3 1 8 0.1512225 0.8487775
4 2 3 0.0000000 1.0000000
5 2 5 0.0172132 0.9827868
6 3 4 0.0000000 1.0000000
7 3 6 0.1689594 1.0000000
8 4 5 0.0000000 1.0000000
9 4 7 0.1689594 1.0000000
10 5 6 0.1192029 1.0000000
11 5 8 0.1689594 1.0000000
12 6 7 0.1192029 1.0000000
13 7 8 0.0000000 1.0000000
> S <- sapply(1:nrow(b), function(i) sum(y[b$li[i]:b$ri[i]]))
> len <- b$ri - b$li + 1
> sizelen <- size * len
> NS <- sizelen - S
> totvar <- ( sum(y[-length(y)] * (size - y[-1])) + sum(y[-1] * (size - y[-length(y)])) ) / 2 / size
> totvar
[1] 2
> stopifnot(all(ifelse(S <= 1, b$lower, S * log(S / sizelen) + ifelse(NS == 0, 0, NS * log(NS / sizelen)) - quant + log(sizelen) - log(totvar) - (S - 1) * log(b$lower) - (NS - 1) * log(1 - b$lower)) < 1e-4))
> stopifnot(all(ifelse(NS <= 1, b$upper - 1, ifelse(S == 0, 0, S * log(S / sizelen)) + NS * log(NS / sizelen) - quant + log(sizelen) - log(totvar) - (S - 1) * log(b$upper) - (NS - 1) * log(1 - b$upper)) < 1e-4))
> #with sqrt penalty
> b <- bounds.MRC(y, q = quant, family = "binom", param = size, penalty = "sqrt", eps = 1e-5)$bounds
> b
li ri lower upper
1 1 1 0.000000e+00 0.9999565
2 1 2 0.000000e+00 0.9874467
3 1 4 6.621083e-05 0.9589785
4 1 8 6.208139e-02 0.9379186
5 2 2 0.000000e+00 0.9999565
6 2 3 3.939781e-05 0.9999606
7 2 5 6.302974e-03 0.9936970
8 3 3 4.349516e-05 1.0000000
9 3 4 3.939781e-05 0.9999606
10 3 6 4.102148e-02 0.9999338
11 4 4 0.000000e+00 0.9999565
12 4 5 3.939781e-05 0.9999606
13 4 7 4.102148e-02 0.9999338
14 5 5 4.349516e-05 1.0000000
15 5 6 1.255329e-02 1.0000000
16 5 8 4.102148e-02 0.9999338
17 6 6 4.349516e-05 1.0000000
18 6 7 1.255329e-02 1.0000000
19 7 7 4.349516e-05 1.0000000
20 7 8 3.939781e-05 0.9999606
21 8 8 0.000000e+00 0.9999565
> S <- sapply(1:nrow(b), function(i) sum(y[b$li[i]:b$ri[i]]))
> len <- b$ri - b$li + 1
> sizelen <- size * len
> NS <- sizelen - S
> stopifnot(all(abs(ifelse(S == 0, b$lower, ifelse(NS == 0, sqrt(2)*sqrt(-sizelen * log(b$lower)), sqrt(2)*sqrt(S * log(S / sizelen / b$lower) + NS * log(NS / sizelen / (1 - b$lower)))) - quant - sqrt(2*(1+log(length(y)/len))) )) < 1e-4))
> stopifnot(all(ifelse(NS == 0, b$upper - 1, ifelse(S == 0,sqrt(2)*sqrt(-sizelen * log(1 - b$upper)),sqrt(2)*sqrt(S * log(S / sizelen / b$upper) + NS * log(NS / sizelen / (1 - b$upper)))) - quant - sqrt(2*(1+log(length(y)/len)))) < 1e-4))
>
> # check Poisson bounds
> y <- c(0,0,1,1)
> quant <- 2
> # without penalty
> b <- bounds.MRC(y, q = quant, family = "poisson", eps = 1e-5)$bounds
> b
li ri lower upper
1 1 1 0.00000000 2.000000
2 1 2 0.00000000 1.000000
3 1 4 0.07929714 1.573094
4 2 2 0.00000000 2.000000
5 2 3 0.02623455 2.252621
6 3 3 0.05246910 4.505241
7 3 4 0.15859428 3.146189
8 4 4 0.05246910 4.505241
> S <- sapply(1:nrow(b), function(i) sum(y[b$li[i]:b$ri[i]]))
> len <- b$ri - b$li + 1
> stopifnot(all(ifelse(S == 0, b$lower, b$lower * ( S / b$lower * log(S / b$lower / len) - S / b$lower + len ) - quant) < 1e-4))
> stopifnot(all(ifelse(S == 0, b$upper * len, b$upper * ( S / b$upper * log(S / b$upper / len) - S / b$upper + len )) - quant < 1e-4))
> # S = 0
> bu0 <- b$upper[1]
> stopifnot(abs(bu0 - quant) < 1e-5)
> stopifnot(b$lower[1] == 0)
> bu00 <- b$upper[2]
> stopifnot(abs(2 * bu00 - quant) < 1e-5)
> stopifnot(b$lower[2] == 0)
> # S = 2
> bu11 <- b$upper[7]
> stopifnot(abs(2 * log(2 / 2 / bu11) - 2 + 2 * bu11 - quant) < 1e-5)
> bl11 <- b$lower[7]
> stopifnot(abs(2 * log(2 / 2 / bl11) - 2 + 2 * bl11 - quant) < 1e-5)
> # with len-penalty
> b <- bounds.MRC(y, q = quant, family = "poisson", penalty = "len", eps = 1e-5)$bounds
> b
li ri lower upper
1 1 1 0.00000000 3.386294
2 1 2 0.00000000 1.346574
3 1 4 0.07929714 1.573097
4 2 2 0.00000000 3.386294
5 2 3 0.01276872 2.687442
6 3 3 0.01260465 6.212926
7 3 4 0.10644479 3.638011
8 4 4 0.01260465 6.212926
> S <- sapply(1:nrow(b), function(i) sum(y[b$li[i]:b$ri[i]]))
> len <- b$ri - b$li + 1
> stopifnot(all(ifelse(S == 0, b$lower, b$lower * ( S / b$lower * log(S / b$lower / len) - S / b$lower + len ) - quant + log(len / length(y))) < 1e-4))
> stopifnot(all(ifelse(S == 0, b$upper * len, b$upper * ( S / b$upper * log(S / b$upper / len) - S / b$upper + len )) - quant + log(len / length(y)) < 1e-4))
> # with sqrt penalty
> b <- bounds.MRC(y, q = quant, family = "poisson", penalty = "sqrt", eps = 1e-5)$bounds
> b
li ri lower upper
1 1 1 0.000000e+00 8.755545
2 1 2 0.000000e+00 3.686762
3 1 4 1.018338e-02 2.822490
4 2 2 0.000000e+00 8.755545
5 2 3 1.154768e-04 5.374135
6 3 3 5.797565e-05 12.262055
7 3 4 9.302612e-03 6.569146
8 4 4 5.797565e-05 12.262055
> S <- sapply(1:nrow(b), function(i) sum(y[b$li[i]:b$ri[i]]))
> len <- b$ri - b$li + 1
> stopifnot(all(ifelse(S == 0,sqrt(2)*sqrt(b$lower * len), sqrt(2) * sqrt(b$lower * ( S / b$lower * log(S / b$lower / len) - S / b$lower + len ))) - quant - sqrt(2*(1+log(length(y)/len))) < 1e-4))
> stopifnot(all(ifelse(S == 0,sqrt(2)*sqrt(b$upper * len), sqrt(2) * sqrt(b$upper * ( S / b$upper * log(S / b$upper / len) - S / b$upper + len ))) - quant - sqrt(2*(1+log(length(y)/len))) < 1e-4))
>
> # with var-penalty
> b <- bounds.MRC(y, q = quant, family = "poisson", penalty = "var", eps = 1e-5)$bounds
> b
li ri lower upper
1 1 1 0.0000000 2.000000
2 1 2 0.0000000 1.000000
3 1 4 0.1015939 1.223771
4 2 2 0.0000000 2.000000
5 2 3 0.0000000 1.846574
6 3 3 0.0000000 3.693147
7 3 4 0.2031879 2.447542
8 4 4 0.0000000 3.693147
> S <- sapply(1:nrow(b), function(i) sum(y[b$li[i]:b$ri[i]]))
> len <- b$ri - b$li + 1
> ifelse(S == 0, b$lower, b$lower * ( S / b$lower * log(S / b$lower / len) - S / b$lower + len ) - quant + log(b$lower * len / sum(y)))
[1] 0 0 -2 0 NaN NaN -2 NaN
> stopifnot(all(ifelse(S <= 1, b$lower, b$lower * ( S / b$lower * log(S / b$lower / len) - S / b$lower + len ) - quant + log(b$lower * len / sum(y))) < 1e-4))
> stopifnot(all(ifelse(S == 0, b$upper * len, b$upper * ( S / b$upper * log(S / b$upper / len) - S / b$upper + len )) - quant + log(b$upper * len / sum(y)) < 1e-4))
>
> # S = 0
> bu0 <- b$upper[1]
> stopifnot(abs(bu0 + log(bu0) - quant - log(sum(y))) < 1e-5)
> stopifnot(b$lower[1] == 0)
> bu00 <- b$upper[2]
> stopifnot(abs(2 * bu00 + log(2 * bu00) - quant - log(sum(y))) < 1e-5)
> stopifnot(b$lower[2] == 0)
> # S = 1
> bu1 <- b$upper[6]
> stopifnot(abs(bu1 - 1 - quant - log(sum(y))) < 1e-5)
> stopifnot(b$lower[6] == 0)
> bu01 <- b$upper[5]
> stopifnot(abs(2 * bu01 - 1 - quant - log(sum(y))) < 1e-5)
> stopifnot(b$lower[5] == 0)
>
>
> # check BoundBinom
> y <- 1:4
> size <- 4
> cand <- stepcand(y, family = "binomial", param = size)
> bounds <- as.data.frame(rbind(
+ c(1, 1, 0, 1), c(1, 2, 1, 0), c(3, 3, 2, 4), c(3, 4, 3, 4), c(4, 4, 4, 4)
+ ))
> names(bounds) <- c("li", "ri", "lower", "upper")
> bounds <- bounds[order(bounds$li, bounds$ri),]
> start <- cumsum(sapply(tapply(bounds$li, ordered(bounds$li, levels = 1:nrow(cand)), identity), length))
> start <- c(0, start[-length(start)]) # C-style
> start[is.na(tapply(bounds$li, ordered(bounds$li, levels = 1:nrow(cand)), length))] <- NA
> with(bounds, cbind(bounds, Cli = li - 1, Cri = ri - 1, Crows = 0:(nrow(bounds)-1)))
li ri lower upper Cli Cri Crows
1 1 1 0 1 0 0 0
2 1 2 1 0 0 1 1
3 3 3 2 4 2 2 2
4 3 4 3 4 2 3 3
5 4 4 4 4 3 3 4
> cbind(as.data.frame(cand[,2:3]), start = start)
rightEnd value start
1 1 0.25 0
2 2 0.50 NA
3 3 0.75 2
4 4 1.00 4
> # normalise bounds
> bbounds <- bounds
> bbounds$lower <- bbounds$lower / size
> bbounds$upper <- bbounds$upper / size
> bounded <- stepbound(cand, list(bounds = bbounds, start = start, feasible = TRUE))
> as.data.frame(bounded)
leftEnd rightEnd value leftIndex rightIndex rightIndexLeftBound
1 1 1 0.250 1 1 1
2 2 3 0.625 2 3 3
3 4 4 1.000 4 4 4
rightIndexRightBound rightEndLeftBound rightEndRightBound cumSum cumSumWe
1 1 1 1 1 1
2 3 3 3 6 3
3 4 4 4 10 4
> stopifnot(all.equal(bounded$rightEnd, c(1, 3, 4)))
> stopifnot(all.eq(bounded$value, c(1, 2.5, 4) / size))
> # attributes(bounded)
> stopifnot(abs(attr(bounded, "cost") - sum(lchoose(size, y)) +sum(dbinom(y, size, fitted(bounded) / size, log = TRUE)))<0.001)
>
> # check BoundPoisson
> cand <- stepcand(y, family = "poisson")
> bounded <- stepbound(cand, list(bounds = bounds, start = start, feasible = TRUE))
> as.data.frame(bounded)
leftEnd rightEnd value leftIndex rightIndex rightIndexLeftBound
1 1 1 1 1 1 1
2 2 4 4 2 4 4
rightIndexRightBound rightEndLeftBound rightEndRightBound cumSum cumSumWe
1 1 1 1 1 1
2 4 4 4 10 4
> stopifnot(all.equal(bounded$rightEnd, c(1, 4)))
> stopifnot(all.eq(bounded$value, c(1, 4)))
> # attributes(bounded)
> attr(bounded, "cost")
[1] 0.5233507
> stopifnot(abs(attr(bounded, "cost") + sum(lfactorial(y)) +sum(dpois(y, fitted(bounded), log = TRUE)))<0.001)
>
> # check BoundGauss
> cand <- stepcand(y, family = "gauss")
> # # call with C-style indices
> # bounded <- with(bounds, .Call('boundedGauss', cand$cumSum, cand$cumSumSq, cand$cumSumWe, as.integer(start), as.integer(ri - 1), as.numeric(lower), as.numeric(upper)))
> bounded <- stepbound(cand, list(bounds = bounds, start = start, feasible = TRUE))
> as.data.frame(bounded)
leftEnd rightEnd value leftIndex rightIndex rightIndexLeftBound
1 1 1 1 1 1 1
2 2 4 4 2 4 4
rightIndexRightBound rightEndLeftBound rightEndRightBound cumSum cumSumWe
1 1 1 1 1 1
2 4 4 4 10 4
cumSumSq
1 1
2 30
> stopifnot(all.equal(bounded$rightEnd, c(1, 4)))
> stopifnot(all.eq(bounded$value, c(1, 4)))
> # attributes(bounded)
> attr(bounded, "cost")
[1] 5
> stopifnot(attr(bounded, "cost") == 4 + 1)
> y <- (-4):4
> MRCoeff(y, lengths = c(1,4,9), signed = TRUE)
[,1] [,2] [,3]
[1,] -4 -5 4.849887e-17
[2,] -3 -3 NA
[3,] -2 -1 NA
[4,] -1 1 NA
[5,] 0 3 NA
[6,] 1 5 NA
[7,] 2 NA NA
[8,] 3 NA NA
[9,] 4 NA NA
> sd <- 0.4
> MRC.quant(1 - 0.05, 9, 1e2) * sd
95%
1.503253
> b <- bounds(y, r = 1e2, param = sd, lengths = c(1,4,9))
> b
$bounds
li ri lower upper
1 1 1 -4.9988136689 -3.0011863311
2 1 4 -2.9994068344 -2.0005931656
3 1 9 -0.3329378896 0.3329378896
4 2 2 -3.9988136689 -2.0011863311
5 2 5 -1.9994068344 -1.0005931656
6 3 3 -2.9988136689 -1.0011863311
7 3 6 -0.9994068344 -0.0005931656
8 4 4 -1.9988136689 -0.0011863311
9 4 7 0.0005931656 0.9994068344
10 5 5 -0.9988136689 0.9988136689
11 5 8 1.0005931656 1.9994068344
12 6 6 0.0011863311 1.9988136689
13 6 9 2.0005931656 2.9994068344
14 7 7 1.0011863311 2.9988136689
15 8 8 2.0011863311 3.9988136689
16 9 9 3.0011863311 4.9988136689
$start
[1] 0 3 5 7 9 11 13 14 15
$feasible
[1] TRUE
attr(,"class")
[1] "bounds" "list"
> sb <- stepbound(y, b)
> sb
Fitted step function of family gauss containing 5 blocks
domain: ( 0 , 9 ]
range: [ -3.5 , 4 ]
cost: 2
> as.data.frame(sb)
leftEnd rightEnd value leftIndex rightIndex rightIndexLeftBound
1 1 2 -3.5 1 2 1
2 3 4 -1.5 3 4 3
3 5 6 0.5 5 6 5
4 7 8 2.5 7 8 7
5 9 9 4.0 9 9 9
rightIndexRightBound rightEndLeftBound rightEndRightBound cumSum cumSumWe
1 2 1 2 -7 2
2 4 3 4 -10 4
3 6 5 6 -9 6
4 8 7 8 -4 8
5 9 9 9 0 9
cumSumSq
1 25
2 30
3 31
4 44
5 60
> stopifnot(nrow(sb) == 3)
Error: nrow(sb) == 3 is not TRUE
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 2.1-10
Check: installed package size
Result: NOTE
installed size is 6.6Mb
sub-directories of 1Mb or more:
libs 5.4Mb
Flavors: r-oldrel-macos-arm64, r-oldrel-macos-x86_64
These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.