diff --git a/rstan/rstan/R/options.R b/rstan/rstan/R/options.R index d3c7b55cc9e..37442482f13 100644 --- a/rstan/rstan/R/options.R +++ b/rstan/rstan/R/options.R @@ -70,39 +70,29 @@ rstan_options <- function(...) { len <- length(a) if (len < 1) return(NULL) a_names <- names(a) - # deal with the case that this function is called as - # rstan_options("a", "b") - if (is.null(a_names)) { - ns <- unlist(a) - if (!is.character(ns)) - stop("rstan_options only accepts arguments as `name=value'") - - ifnotfound_fun <- function(x) { - warning("rstan option '", x, "' not found") - NA - } - - r <- mget(unlist(a), envir = e, ifnotfound = list(ifnotfound_fun)) - if (length(r) == 1) return(r[[1]]) - return(invisible(r)) + if (is.null(a_names)) { # case like rstan_options("a", "b") + empty <- rep(TRUE, len) + empty_len <- len + } else { # case like rstan_options(a = 3, b = 4, "c") + empty <- (a_names == '') + empty_len <- sum(empty) } - # the case for, for example, - # rstan_options(a = 3, b = 4, "c") - empty <- (a_names == '') - - opt_names <- c(a_names[!empty], unlist(a[empty])) - r <- mget(opt_names, envir = e, ifnotfound = list(ifnotfound_fun)) - - lapply(a_names[!empty], - FUN = function(n) { - if (n == 'plot_rhat_breaks') { - assign(n, sort(a[[n]]), e) - } else { - assign(n, a[[n]], e) - } - }) - - if (length(r) == 1) return(r[[1]]) + for (i in which(empty)) { + if (!is.character(a[[i]])) stop("rstan_options only accepts arguments as 'name=value' or 'name'") + } + + r <- if (empty_len < len) mget(a_names[!empty], envir = e, ifnotfound = NA) + if (empty_len > 0) + r <- c(r, mget(unlist(a[empty]), envir = e, + ifnotfound = list(function(x) { warning("rstan option '", x, "' not found"); NA }))) + + # set options + for (n in a_names[!empty]) { + if (n == 'plot_rhat_breaks') { assign(n, sort(a[[n]]), e); next } + assign(n, a[[n]], e) + } + + if (len == 1) return(invisible(r[[1]])) invisible(r) } diff --git a/rstan/rstan/inst/unitTests/runit.test.options.R b/rstan/rstan/inst/unitTests/runit.test.options.R index 871c9a7d9ad..94adad37789 100644 --- a/rstan/rstan/inst/unitTests/runit.test.options.R +++ b/rstan/rstan/inst/unitTests/runit.test.options.R @@ -18,6 +18,11 @@ test_options2 <- function() { checkEquals(ov, 22) o <- rstan:::rstan_options('a', 'b') checkEquals(o$a, 34) + o <- rstan:::rstan_options('a', 'b', 'c') + checkEquals(o$c, NA) + o <- rstan:::rstan_options('a', 'b', 'c', d = 38) + checkEquals(o$d, NA) + checkEquals(rstan:::rstan_options("d"), 38) } test_plot_rhat_breaks <- function() {