Merge branch 'master' of https://code.google.com/p/stan

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)
 } 
 

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() {