Skip to content

Commit

Permalink
trying fixing R cmd check NOTE
Browse files Browse the repository at this point in the history
  • Loading branch information
jgabry committed Jan 17, 2024
1 parent ea8df35 commit 5e51826
Show file tree
Hide file tree
Showing 4 changed files with 11 additions and 11 deletions.
10 changes: 5 additions & 5 deletions R/helpers-mcmc.R
Original file line number Diff line number Diff line change
Expand Up @@ -51,13 +51,13 @@ prepare_mcmc_array <- function(x,
if (is.matrix(x)) {
x <- x[, pars, drop=FALSE]
if (length(transformations)) {
x <- apply_transformations(x, transformations)
x <- apply_transformations(x, transformations = transformations)
}
x <- array(x, dim = c(nrow(x), 1, ncol(x)))
} else {
x <- x[, , pars, drop = FALSE]
if (length(transformations)) {
x <- apply_transformations(x, transformations)
x <- apply_transformations(x, transformations = transformations)
}
}

Expand Down Expand Up @@ -388,10 +388,10 @@ validate_transformations <-
#' functions.
#' @return x, with tranformations having been applied to some parameters.
#'
apply_transformations <- function(x, transformations = list(), ...) {
apply_transformations <- function(x, ...) {
UseMethod("apply_transformations")
}
apply_transformations.matrix <- function(x, transformations = list()) {
apply_transformations.matrix <- function(x, ..., transformations = list()) {
pars <- colnames(x)
x_transforms <- validate_transformations(transformations, pars)
for (p in names(x_transforms)) {
Expand All @@ -400,7 +400,7 @@ apply_transformations.matrix <- function(x, transformations = list()) {

x
}
apply_transformations.array <- function(x, transformations = list()) {
apply_transformations.array <- function(x, ..., transformations = list()) {
stopifnot(length(dim(x)) == 3)
pars <- dimnames(x)[[3]]
x_transforms <- validate_transformations(transformations, pars)
Expand Down
6 changes: 3 additions & 3 deletions R/mcmc-diagnostics.R
Original file line number Diff line number Diff line change
Expand Up @@ -360,17 +360,17 @@ mcmc_acf_bar <-
#' `x <= breaks[1]`, `breaks[1] < x <= breaks[2]`, `x > breaks[2]`).
#' @return A factor the same length as `x` with three levels.
#' @noRd
diagnostic_factor <- function(x, breaks, ...) {
diagnostic_factor <- function(x, ...) {
UseMethod("diagnostic_factor")
}

diagnostic_factor.rhat <- function(x, breaks = c(1.05, 1.1)) {
diagnostic_factor.rhat <- function(x, ..., breaks = c(1.05, 1.1)) {
cut(x, breaks = c(-Inf, breaks, Inf),
labels = c("low", "ok", "high"),
ordered_result = FALSE)
}

diagnostic_factor.neff_ratio <- function(x, breaks = c(0.1, 0.5)) {
diagnostic_factor.neff_ratio <- function(x, ..., breaks = c(0.1, 0.5)) {
cut(x, breaks = c(-Inf, breaks, Inf),
labels = c("low", "ok", "high"),
ordered_result = FALSE)
Expand Down
4 changes: 2 additions & 2 deletions tests/testthat/test-helpers-mcmc.R
Original file line number Diff line number Diff line change
Expand Up @@ -193,11 +193,11 @@ test_that("validate_transformations throws correct errors", {
test_that("apply_transformations works", {
trans <- list('beta[1]' = "exp", sigma = function(x) x^2)

arr_trans <- apply_transformations(arr, trans)
arr_trans <- apply_transformations(arr, transformations = trans)
expect_equal(arr_trans[,, "sigma"], arr[,, "sigma"]^2)
expect_equal(arr_trans[,, "beta[1]"], exp(arr[,, "beta[1]"]))

mat_trans <- apply_transformations(mat, trans)
mat_trans <- apply_transformations(mat, transformations = trans)
expect_equal(mat_trans[, "sigma"], mat[, "sigma"]^2)
expect_equal(mat_trans[, "beta[1]"], exp(mat[, "beta[1]"]))
})
Expand Down
2 changes: 1 addition & 1 deletion vignettes/visual-mcmc-diagnostics.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -154,7 +154,7 @@ schools_mod_ncp <- stan_model("schools_mod_ncp.stan")
We then fit the model by calling Stan's MCMC algorithm using the `sampling`
function (the increased `adapt_delta` param is to make the sampler a bit more "careful" and avoid false positive divergences),
```{r fit-models-hidden, results='hide', message=FALSE}
fit_cp <- sampling(schools_mod_cp, data = schools_dat, seed = 803214054, control = list(adapt_delta = 0.9))
fit_cp <- sampling(schools_mod_cp, data = schools_dat, seed = 803214055, control = list(adapt_delta = 0.9))
fit_ncp <- sampling(schools_mod_ncp, data = schools_dat, seed = 457721433, control = list(adapt_delta = 0.9))
```
and extract a `iterations x chains x parameters` array of posterior draws with
Expand Down

0 comments on commit 5e51826

Please sign in to comment.