Tidy rewrite

.Rbuildignore

@@ -8,4 +8,6 @@
 ^\.github$
 ^bugs$
 ^CLAUDE\.md$
-^\.claude$
+^\.claude$
+^pkgdown$
+^README_files$

.github/workflows/R-CMD-check.yaml

@@ -1,16 +1,13 @@
-# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag.
-# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches:
-      - main
-      - master
+    branches: [main, master]
   pull_request:
-    branches:
-      - main
-      - master
 
-name: R-CMD-check
+name: R-CMD-check.yaml
+
+permissions: read-all
 
 jobs:
   R-CMD-check:
@@ -22,65 +19,33 @@ jobs:
       fail-fast: false
       matrix:
         config:
+          - {os: macos-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
-          - {os: macOS-latest, r: 'release'}
-          - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
-          - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest,   r: 'release'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
 
     env:
-      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
-      RSPM: ${{ matrix.config.rspm }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
 
-      - uses: r-lib/actions/setup-pandoc@v1
-
-      - name: Query dependencies
-        run: |
-          install.packages('remotes')
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
-
-      - name: Restore R package cache
-        if: runner.os != 'Windows'
-        uses: actions/cache@v2
+      - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
-
-      - name: Install system dependencies
-        if: runner.os == 'Linux'
-        run: |
-          while read -r cmd
-          do
-            eval sudo $cmd
-          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
-
-      - name: Install dependencies
-        run: |
-          remotes::install_deps(dependencies = TRUE)
-          remotes::install_cran("rcmdcheck")
-        shell: Rscript {0}
-
-      - name: Check
-        env:
-          _R_CHECK_CRAN_INCOMING_REMOTE_: false
-        run: |
-          options(crayon.enabled = TRUE)
-          rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
-        shell: Rscript {0}
+          extra-packages: any::rcmdcheck
+          needs: check
 
-      - name: Upload check results
-        if: failure()
-        uses: actions/upload-artifact@main
+      - uses: r-lib/actions/check-r-package@v2
         with:
-          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
-          path: check
+          upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

.gitignore

@@ -39,6 +39,8 @@ inst/examples
 
 bugs/
 
+docs/
+
 ^CLAUDE\.md$
 .claude/
 

DESCRIPTION

@@ -21,9 +21,11 @@ Suggests:
     rmarkdown,
     knitr,
     tinytest
-Imports: graphics,
+Imports: cli,
+    graphics,
     generics,
     lifecycle,
+    rlang,
     stats,
     tibble,
     utils

NAMESPACE

@@ -1,8 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(glance,bcaboot)
+S3method(generics::glance,bcaboot)
+S3method(generics::tidy,bcaboot)
+S3method(ggplot2::autoplot,bcaboot)
 S3method(print,bcaboot)
-S3method(tidy,bcaboot)
 export(bca_nonpar)
 export(bca_par)
 export(bcajack)
@@ -11,6 +12,10 @@ export(bcapar)
 export(bcaplot)
 export(glance)
 export(tidy)
+importFrom(cli,cli_abort)
+importFrom(cli,cli_h3)
+importFrom(cli,cli_text)
+importFrom(cli,cli_warn)
 importFrom(generics,glance)
 importFrom(generics,tidy)
 importFrom(graphics,abline)
@@ -20,6 +25,8 @@ importFrom(graphics,points)
 importFrom(graphics,segments)
 importFrom(graphics,text)
 importFrom(lifecycle,deprecate_warn)
+importFrom(lifecycle,deprecated)
+importFrom(rlang,.data)
 importFrom(stats,approx)
 importFrom(stats,cov)
 importFrom(stats,dnorm)
@@ -31,5 +38,6 @@ importFrom(stats,runif)
 importFrom(stats,sd)
 importFrom(stats,smooth.spline)
 importFrom(stats,var)
+importFrom(tibble,tibble)
 importFrom(utils,setTxtProgressBar)
 importFrom(utils,txtProgressBar)

NEWS.md

@@ -24,12 +24,39 @@
 ## Deprecations
 
 * `bcajack()`, `bcajack2()`, `bcapar()`, and `bcaplot()` are
- deprecated with `lifecycle` warnings (once per session). They will
+  deprecated with `lifecycle` warnings (once per session). They will
   continue to work through thin wrappers that translate to the new
   API.
 
+## Bug fixes
+
+* **Issue #2**: Fixed grouped jackknife (`n_groups < n`) using
+  `sapply(seq_len_m, sample.int, ...)` which accidentally passed
+  iteration values as the first positional arg, overriding the
+  `n=` keyword and enabling replacement. Replaced with
+  `matrix(sample.int(n, n-r), nrow=m)` for correct without-replacement
+  partition. (Reported by admash)
+
+* **Issue #7**: Fixed dimension drop when `x` is a single-column
+  matrix (vector input). `x[-i, ]` on an `n x 1` matrix returned a
+  vector instead of a matrix, causing type inconsistency between
+  jackknife and bootstrap code paths. Added `drop = FALSE` to all
+  matrix subsetting passed to `func`. (Reported by R180)
+
+* **Issue #4 / #1**: `regression_accel` now checks for underdetermined
+  regression (`nearby samples < ncol(Y)`) and errors with an
+  actionable message instead of silently returning NAs. Suggests
+  increasing `B`, increasing `kl_fraction`, or switching to
+  `accel = "jackknife"`. (Reported by Tim Pollington, Thomas Covert)
+
+* **PR #8**: Fixed missing `return()` in `K = 0` early-exit path of
+  `bcajack()`, `bcajack2()`, and `bcapar()`, which caused execution
+  to fall through to the `K > 0` code. In the rewrite, all early
+  exits use explicit `return(new_bcaboot(...))`. (Reported by Bettina
+  Gruen)
+
 ## New features
- 
+
 * `tidy()` method: returns a tibble with one row per (confidence
   level, method) pair, following broom conventions (`conf.level`,
   `method`, `estimate`, `conf.low`, `conf.high`).
@@ -47,9 +74,11 @@
 * `bca_nonpar()` always computes the gbca diagnostic when using
   `accel = "regression"` (with `tryCatch` for robustness).
 
+* All user-facing messages use `cli` for consistent formatting.
+
 ## Dependencies
 
-* Added `tibble`, `generics`, `lifecycle` to Imports.
+* Added `cli`, `tibble`, `generics`, `lifecycle` to Imports.
 * Added `ggplot2` to Suggests (for `autoplot()`).
 
 ## Internal

R/abcpar.R

@@ -29,7 +29,7 @@ abcpar <- function (func,bb,lambda = 0.001,alpha = c(0.025, 0.05, 0.1, 0.16), ..
     ## Derivatives are computed along eigenvectors (principal directions).
     eig <- eigen(S)
     if (any(eig$values <= 0))
-        stop("Covariance matrix of bb is singular or near-singular; ABC method requires full rank")
+        cli::cli_abort("Covariance matrix of {.arg bb} is singular or near-singular; ABC method requires full rank.")
     evals <- (eig$values)^0.5
     evecs <- as.matrix(eig$vectors)
     ## Numerical first (b.) and second (b..) derivatives of func along each

R/autoplot.R

@@ -21,12 +21,13 @@
 #' autoplot(result)
 #' }
 #'
-#' @export
+#' @exportS3Method ggplot2::autoplot
 autoplot.bcaboot <- function(object, ...) {
     if (!requireNamespace("ggplot2", quietly = TRUE)) {
-        stop("Package 'ggplot2' is required for autoplot(). ",
-             "Install it with install.packages('ggplot2').",
-             call. = FALSE)
+        cli::cli_abort(c(
+            "Package {.pkg ggplot2} is required for {.fun autoplot}.",
+            "i" = "Install it with {.code install.packages(\"ggplot2\")}."
+        ))
     }
 
     df <- tidy.bcaboot(object)

R/bca_core.R

@@ -34,6 +34,16 @@ regression_accel <- function(Y, tt, t0, pct) {
     kl_cutoff <- stats::quantile(kl_dist, pct)
     nearby_idx <- seq_len(B)[kl_dist <= kl_cutoff]
 
+    if (length(nearby_idx) < m) {
+        cli::cli_abort(c(
+            "Regression for acceleration estimation is underdetermined.",
+            "x" = "{length(nearby_idx)} nearby bootstrap samples but {m} columns in the count matrix.",
+            "i" = "Increase {.arg B} so that {.code B * kl_fraction > {m}}.",
+            "i" = "Increase {.arg kl_fraction} (currently {round(pct, 3)}).",
+            "i" = "Use {.code accel = \"jackknife\"} which avoids this regression."
+        ))
+    }
+
     ## Influence via local regression on nearby count vectors
     reg_infl <- as.vector(m * stats::lm(tt[nearby_idx] ~ Y[nearby_idx, ] - 1)$coef)
     reg_infl <- reg_infl - mean(reg_infl)
@@ -65,7 +75,7 @@ jackknife_accel <- function(x, func, ..., m, mr) {
 
     if (m == n) {
         for (i in seq_len(n)) {
-            u[i] <- func(x[-i, ], ...)
+            u[i] <- func(x[-i, , drop = FALSE], ...)
         }
         jack_infl <- (mean(u) - u) * (m - 1)
         a <- (1 / 6) * sum(jack_infl^3) / (sum(jack_infl^2))^1.5
@@ -75,12 +85,12 @@ jackknife_accel <- function(x, func, ..., m, mr) {
         r <- n %% m
         seq_len_m <- seq_len(m)
         for (k in seq_len(mr)) {
-            Imat <- sapply(seq_len_m, sample.int, n = n, size = n - r)
+            Imat <- matrix(sample.int(n, size = n - r), nrow = m)
             Iout <- setdiff(seq_len(n), Imat)
             for (j in seq_len_m) {
                 Ij <- setdiff(seq_len_m, j)
                 ij <- c(c(Imat[Ij, ], Iout))
-                u[j] <- func(x[ij, ])
+                u[j] <- func(x[ij, , drop = FALSE])
             }
             jack_infl <- (mean(u) - u) * (m - 1)
             aa[k] <- (1/6) * sum(jack_infl^3)/(sum(jack_infl^2))^1.5
@@ -91,7 +101,7 @@ jackknife_accel <- function(x, func, ..., m, mr) {
         ## Use the last partition's influence values (consistent with original bcajack)
         jack_infl <- (mean(u) - u) * (m - 1)
     } else {
-        stop("m must be <= n")
+        cli::cli_abort("{.arg n_groups} ({m}) must be <= number of observations ({n}).")
     }
 
     list(a = a, sdjack = sdjack, jack_infl = jack_infl)
@@ -123,7 +133,7 @@ bootstrap_resample <- function(x, B, func, ..., m, verbose, boot_data = NULL) {
         if (verbose) pb <- utils::txtProgressBar(min = 0, max = B, style = 3)
         for (k in seq_len(B)) {
             ik <- ii[k, ]
-            tt[k] <- func(x[ik, ], ...)
+            tt[k] <- func(x[ik, , drop = FALSE], ...)
             Y[k, ] <- table(c(ik, 1:n)) - 1
             if (verbose) utils::setTxtProgressBar(pb, k)
         }
@@ -140,13 +150,13 @@ bootstrap_resample <- function(x, B, func, ..., m, verbose, boot_data = NULL) {
             ik <- ii[k, ]
             Ik <- c(t(Imat[ik, ]))
             Ik <- c(Ik, Iout)
-            tt[k] <- func(x[Ik, ], ...)
+            tt[k] <- func(x[Ik, , drop = FALSE], ...)
             Y[k, ] <- table(c(ik, 1:m)) - 1
             if (verbose) utils::setTxtProgressBar(pb, k)
         }
         if (verbose) close(pb)
     } else {
-        stop("m must be <= n")
+        cli::cli_abort("{.arg n_groups} ({m}) must be <= number of observations ({n}).")
     }
 
     list(Y = Y, tt = tt, t0 = t0, B = B)

R/bca_nonpar.R

@@ -114,7 +114,7 @@ bca_nonpar <- function(x, B, func, ...,
             for (j in seq_len(B)) {
                 ij <- sample(x = n, size = n, replace = TRUE)
                 Yj <- table(c(ij, 1:n)) - 1
-                tt[j] <- func(x[ij, ], ...)
+                tt[j] <- func(x[ij, , drop = FALSE], ...)
                 boot_wt_sum <- boot_wt_sum + tt[j] * Yj
                 boot_ct_sum <- boot_ct_sum + Yj
                 if (verbose) utils::setTxtProgressBar(pb, j)
@@ -154,8 +154,7 @@ bca_nonpar <- function(x, B, func, ...,
         diagnostic <- tryCatch(
             gbca_diagnostic(Y, tt, t0, a, sdjack, local_dir, alpha),
             error = function(e) {
-                warning("gbca diagnostic failed: ", conditionMessage(e),
-                        call. = FALSE)
+                cli::cli_warn("gbca diagnostic failed: {conditionMessage(e)}")
                 NULL
             }
         )

R/bcaboot.R

@@ -10,10 +10,22 @@
 #' bca analysis would lie in the nonparametric estimation of the
 #' acceleration, often a negligible error.
 #'
-#' @name bcaboot
-#'
+#' @importFrom generics tidy glance
+#' @importFrom rlang .data
+#' @importFrom lifecycle deprecate_warn deprecated
+#' @importFrom cli cli_abort cli_warn cli_text cli_h3
+#' @importFrom tibble tibble
+#' @importFrom stats sd qnorm pnorm dnorm lm cov var quantile approx smooth.spline runif
+#' @importFrom graphics abline lines plot points segments text
+#' @importFrom utils setTxtProgressBar txtProgressBar
 "_PACKAGE"
 
+#' @export
+generics::tidy
+
+#' @export
+generics::glance
+
 
 #' Blood and other measurements in diabetics
 #'