CRAN Package Check Results for Package stepR

Last updated on 2025-07-06 21:48:34 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 88.48 172.71 261.19 OK
r-devel-linux-x86_64-fedora-clang 2.1-10 742.05 OK
r-devel-linux-x86_64-fedora-gcc 2.1-10 656.92 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 151.00 319.00 470.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 179.00 424.00 603.00 OK

Check Details

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.