Last updated on 2024-10-16 01:48:59 CEST.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 2.1-9 | 130.27 | 276.94 | 407.21 | NOTE | |
| r-devel-linux-x86_64-debian-gcc | 2.1-9 | 89.53 | 167.78 | 257.31 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 2.1-9 | 810.91 | OK | |||
| r-devel-linux-x86_64-fedora-gcc | 2.1-9 | 769.15 | OK | |||
| r-devel-windows-x86_64 | 2.1-9 | 154.00 | 319.00 | 473.00 | NOTE | |
| r-patched-linux-x86_64 | 2.1-9 | 130.60 | 259.99 | 390.59 | OK | |
| r-release-linux-x86_64 | 2.1-9 | 125.13 | 258.38 | 383.51 | OK | |
| r-release-macos-arm64 | 2.1-9 | 169.00 | NOTE | |||
| r-release-macos-x86_64 | 2.1-9 | 246.00 | WARN | |||
| r-release-windows-x86_64 | 2.1-9 | 150.00 | 319.00 | 469.00 | OK | |
| r-oldrel-macos-arm64 | 2.1-9 | 184.00 | NOTE | |||
| r-oldrel-macos-x86_64 | 2.1-9 | 376.00 | NOTE | |||
| r-oldrel-windows-x86_64 | 2.1-9 | 172.00 | 402.00 | 574.00 | OK |
Version: 2.1-9
Check: Rd cross-references
Result: NOTE
Found the following Rd file(s) with Rd \link{} targets missing package
anchors:
computeBounds.Rd: R.cache
critVal.Rd: R.cache, loadCache, saveCache, getCacheRootPath
stepFit.Rd: R.cache
stepR-package.Rd: R.cache
Please provide package anchors for all Rd \link{} targets not in the
package itself and the base packages.
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-devel-windows-x86_64
Version: 2.1-9
Check: tests
Result: ERROR
Running ‘tests.R’ [0s/1s]
Running ‘testthat.R’ [102s/126s]
Running the tests in ‘tests/tests.R’ failed.
Complete output:
>
>
> require(stepR)
Loading required package: stepR
Successfully loaded stepR package version 2.1-9.
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.445023
> b <- bounds(y, r = 1e2, param = sd, lengths = c(1,4,9))
> b
$bounds
li ri lower upper
1 1 1 -4.999874e+00 -3.000126e+00
2 1 4 -2.999937e+00 -2.000063e+00
3 1 9 -3.332914e-01 3.332914e-01
4 2 2 -3.999874e+00 -2.000126e+00
5 2 5 -1.999937e+00 -1.000063e+00
6 3 3 -2.999874e+00 -1.000126e+00
7 3 6 -9.999371e-01 -6.294329e-05
8 4 4 -1.999874e+00 -1.258866e-04
9 4 7 6.294329e-05 9.999371e-01
10 5 5 -9.998741e-01 9.998741e-01
11 5 8 1.000063e+00 1.999937e+00
12 6 6 1.258866e-04 1.999874e+00
13 6 9 2.000063e+00 2.999937e+00
14 7 7 1.000126e+00 2.999874e+00
15 8 8 2.000126e+00 3.999874e+00
16 9 9 3.000126e+00 4.999874e+00
$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-gcc
Version: 2.1-9
Check: installed package size
Result: NOTE
installed size is 6.0Mb
sub-directories of 1Mb or more:
libs 4.8Mb
Flavors: r-release-macos-arm64, r-release-macos-x86_64, r-oldrel-macos-arm64, r-oldrel-macos-x86_64
Version: 2.1-9
Check: re-building of vignette outputs
Result: WARN
Error(s) in re-building vignettes:
...
--- re-building ‘StepR.Rnw’ using knitr
Error: processing vignette 'StepR.Rnw' failed with diagnostics:
Running 'texi2dvi' on 'StepR.tex' failed.
LaTeX errors:
! Undefined control sequence.
l.224 \hlkwd{set.seed}\hldef
{(}\hlnum{1}\hldef{)}
?
! Emergency stop.
! Emergency stop.
l.224
End of file on the terminal!
! ==> Fatal error occurred, no output PDF file produced!
--- failed re-building ‘StepR.Rnw’
SUMMARY: processing the following file failed:
‘StepR.Rnw’
Error: Vignette re-building failed.
Execution halted
Flavor: r-release-macos-x86_64