Merge branch 'develop'

Author: jgabry

.Rbuildignore

@@ -6,3 +6,4 @@ LICENSE
 ^README\.md$
 .gitignore
 ^cran-comments\.md$
+^revdep$

.travis.yml

@@ -1,20 +1,31 @@
 language: r
 sudo: required
-warnings_are_errors: false
+
+cran: http://cran.rstudio.com/
+r_check_revdep: false
+pandoc: false
+
+env:
+  global:
+    - _R_CHECK_FORCE_SUGGESTS_=false
 
 r_binary_packages:
-  - reshape2
+  - coda
+  - dygraphs
   - ggplot2
-  - jsonlite
-  - Rcpp
   - gtools
-  - markdown
+  - httpuv
+  - inline
+  - jsonlite
   - knitr
+  - markdown
+  - reshape2
+  - Rcpp
+  - RUnit
+  - shiny
+  - testthat
   - xts
-  
-env:
-  global:
-    - _R_CHECK_FORCE_SUGGESTS_=false
+  - yaml
 
 notifications:
   email:

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shinystan
 Title: Interactive Visual and Numerical Diagnostics and Posterior Analysis for Bayesian Models
-Version: 2.0.0
-Date: 2015-08-09
+Version: 2.0.1
+Date: 2015-09-17
 Authors@R: c(person("Jonah", "Gabry", role = c("aut", "cre"),
     email = "[email protected]"),
       person(family = "Stan Development Team", role = "ctb"),
@@ -25,7 +25,6 @@ URL: https://github.com/stan-dev/shinystan, http://mc-stan.org/
 BugReports: https://github.com/stan-dev/shinystan/issues
 Depends: 
     R (>= 3.1.0),
-    ggplot2 (>= 1.0.0),
     shiny (>= 0.12.1)
 License: GPL (>=3)
 LazyData: true
@@ -37,16 +36,17 @@ Suggests:
 Imports: 
     DT (>= 0.1),
     dygraphs (>= 0.4.5),
+    ggplot2 (>= 1.0.0),
     gridExtra,
     gtools,
     markdown (>= 0.7.4),
     methods,
     reshape2,
     stats,
-    shinyjs (>= 0.0.7.0),
+    shinyjs (>= 0.1.0),
     shinythemes (>= 1.0.1),
     threejs (>= 0.2.1),
     utils,
-    xtable (>= 1.7-4),
+    xtable,
     xts (>= 0.9-7)
 VignetteBuilder: knitr

NAMESPACE

@@ -28,6 +28,8 @@ importFrom(shinyjs,colourInput)
 importFrom(shinyjs,useShinyjs)
 importFrom(shinythemes,shinytheme)
 importFrom(stats,acf)
+importFrom(stats,model.frame)
+importFrom(stats,model.response)
 importFrom(stats,quantile)
 importFrom(stats,time)
 importFrom(stats,var)

NEWS.md

@@ -1,11 +1,18 @@
-## ShinyStan version 2.0.0 (major update)
+# `shinystan news`
+
+### Version 2.0.1
+* Fixes small bugs and typos
+* Adds support for stanreg objects
+* Moves ggplot2 from Depends to Imports
+
+### Version 2.0.0 (major update)
 
 Version 2.0.0 has a new look, a new(ish) name, and a lot of new functionality. 
 Many bugs have also been fixed (see GitHub issue tracker). 
 
 It's also now [available on CRAN](https://cran.rstudio.com/web/packages/shinystan/index.html).
 
-### Names
+### New names
 * The name of the R package is **shinystan** and the app/GUI is **ShinyStan**. 
 
 ### Deploy ShinyStan apps to shinyapps.io (RStudio's ShinyApps service)

R/deploy_shinystan.R

@@ -81,15 +81,18 @@ deploy_shinystan <- function(sso, appName, account = NULL, ...) {
     file_name <- file.path(deployDir, paste0(ff, ".R"))
     fconn <- file(file_name, 'r+') 
     original_content <- readLines(fconn) 
+    if (ff %in% c("ui", "server")) {
+      sel <- grep(".shinystan_temp_object", original_content)
+      original_content <- original_content[-sel] 
+    }
     new_lines <- get(paste0(ff, "_lines"))
     writeLines(c(new_lines, original_content), con = fconn) 
     close(fconn) 
   }
 
   # save shinystan_object to deployDir
-  .shinystan_temp_object <- sso
-  save(.shinystan_temp_object, 
-       file = file.path(deployDir, "shinystan_temp_object.RData"))
+  object <- sso
+  save(object, file = file.path(deployDir, "shinystan_temp_object.RData"))
   deploy <- getFromNamespace("deployApp", "shinyapps")
   # save ppcheck_data and set ppcheck defaults
   pp <- list(...)

R/launch_shinystan.R

@@ -74,16 +74,15 @@ launch_shinystan <- function(object, rstudio = getOption("shinystan.rstudio"),
   name <- deparse(substitute(object))
   no_name <- substr(name, 1, 12) == "as.shinystan"
   if (missing(object)) 
-    stop("Please specify a shinystan or stanfit object.")
+    stop("Please specify a shinystan or stanfit object.", call. = FALSE)
   message("\nLoading... \n", 
           "Note: for large models ShinyStan may take a few moments to launch.")
 
   if (inherits(object, "stanreg"))
-    object <- object$stanfit
+    object <- stanreg2shinystan(object)
   if (inherits(object, "stanfit"))
     object <- stan2shinystan(object)
   if (!is.shinystan(object))
     stop(paste(name, "is not a valid input. See ?launch_shinystan"))
-  on.exit(cleanup_shinystan())
   invisible(launch(object, rstudio, ...))
 }

R/launch_shinystan_demo.R

@@ -40,6 +40,5 @@
 launch_shinystan_demo <- function(rstudio = getOption("shinystan.rstudio"), 
                                   ...) {
   demo_name <- "eight_schools"
-  on.exit(cleanup_shinystan())
   invisible(launch(get(demo_name), rstudio, ...))
 }

R/misc.R

@@ -19,9 +19,9 @@ sso_check <- function(sso) {
   else 
     invisible(TRUE)
 }
-is_stan <- function(X) {
-  inherits(X, "stanfit")
-}
+is.stanfit <- function(X) inherits(X, "stanfit")
+is.stanreg <- function(X) inherits(X, "stanreg")
+
 rstan_check <- function() {
   if (!requireNamespace("rstan", quietly = TRUE)) 
     stop("You need to have the RStan package installed to use this option.", 
@@ -32,15 +32,13 @@ coda_check <- function() {
     stop("You need to have the coda package installed to use this option.", 
          call. = FALSE)
 }
-cleanup_shinystan <- function() {
-  rm(list = ".shinystan_temp_object", envir = .GlobalEnv)
-}
 
 launch <- function(object, rstudio = FALSE, ...) {
   stopifnot(is.shinystan(object))
   launch.browser <- if (!rstudio) 
     TRUE else getOption("shiny.launch.browser", interactive())
-  assign(".shinystan_temp_object", object, inherits = TRUE)
+  .sso_env$.shinystan_temp_object <- object
+  on.exit(.sso_env$.shinystan_temp_object <- NULL, add = TRUE)
   shiny::runApp(system.file("ShinyStan", package = "shinystan"), 
                 launch.browser = launch.browser, ...)
 }
@@ -65,10 +63,10 @@ grepl_ic <- function(pattern, x, ignore.case = TRUE) {
 
 get_type <- function(x) {
   if (is.shinystan(x)) return("shinystan")
-  else if (is_stan(x)) return("stanfit")
+  else if (is.stanfit(x)) return("stanfit")
+  else if (is.stanreg(x)) return("stanreg")
   else if (inherits(x, "mcmc.list")) return("mcmclist")
-  else if (is.list(x) & !inherits(x, "mcmc.list")) return("chainlist")
-  else if (inherits(x, "stanreg")) return("stanreg")
+  else if (is.list(x)) return("chainlist")
   else return("other")
 }
 

R/stan2shinystan.R

@@ -13,56 +13,75 @@
 # You should have received a copy of the GNU General Public License along with
 # this program; if not, see <http://www.gnu.org/licenses/>.
 
+
+.rename_scalar <- function(sso, oldname = "lp__", newname = "log-posterior") {
+  p <- which(sso@param_names == oldname)
+  if (identical(integer(0), p)) 
+    return(sso)
+  sso@param_names[p] <- 
+    dimnames(sso@samps_all)$parameters[p] <-
+      names(sso@param_dims)[which(names(sso@param_dims) == oldname)] <- newname
+  sso
+}
+
 # convert stanfit object to shinystan object
 stan2shinystan <- function(stanfit, model_name, notes) {
   # notes: text to add to user_model_info slot
   rstan_check()
-  if (!inherits(stanfit, "stanfit")) {
+  if (!is.stanfit(stanfit)) {
     name <- deparse(substitute(stanfit))
     stop(paste(name, "is not a stanfit object."))
   }
 
-  stan_args <- stanfit@stan_args[[1]]
+  stan_args <- stanfit@stan_args[[1L]]
+  stan_method <- stan_args$method
+  vb <- stan_method == "variational"
   from_cmdstan_csv <- ("engine" %in% names(stan_args))
   stan_algorithm <- if (from_cmdstan_csv) 
     toupper(stan_args$engine) else stan_args$algorithm
   warmup <- if (from_cmdstan_csv) stanfit@sim$warmup2[1L] else stanfit@sim$warmup
   nWarmup <- if (from_cmdstan_csv) warmup else floor(warmup / stanfit@sim$thin)
 
-  max_td <- stanfit@stan_args[[1]]$control
-  if (is.null(max_td)) 
+  cntrl <- stanfit@stan_args[[1L]]$control
+  if (is.null(cntrl)) 
     max_td <- 11
   else {
-    max_td <- max_td$max_treedepth
+    max_td <- cntrl$max_treedepth
     if (is.null(max_td)) 
       max_td <- 11
   }
 
   samps_all <- rstan::extract(stanfit, permuted = FALSE, inc_warmup = TRUE)
-  param_names <- dimnames(samps_all)[[3]] # stanfit@sim$fnames_oi
+  param_names <- dimnames(samps_all)[[3L]] # stanfit@sim$fnames_oi
   param_dims <- stanfit@sim$dims_oi
 
-  if (!(stan_algorithm %in% c("NUTS", "HMC"))) {
-    warning("Most shinyStan features are only available for models using
+  if (!vb && !(stan_algorithm %in% c("NUTS", "HMC"))) {
+    warning("Most features are only available for models using
             algorithm NUTS or algorithm HMC.")
   }
-  
   mname <- if (!missing(model_name)) model_name else stanfit@model_name
   mcode <- rstan::get_stancode(stanfit)
 
+  sampler_params <- if (vb) list(NA) else rstan::get_sampler_params(stanfit)
+  stan_summary <- rstan::summary(stanfit)$summary
+  if (vb) stan_summary <- cbind(stan_summary, Rhat = NA, n_eff = NA, se_mean = NA)
+  
   slots <- list()
   slots$Class <- "shinystan"
   slots$model_name <- mname
   slots$param_names <- param_names
   slots$param_dims <- param_dims
   slots$samps_all <- samps_all
-  slots$summary <- rstan::summary(stanfit)$summary
-  slots$sampler_params <- rstan::get_sampler_params(stanfit)
+  slots$summary <- stan_summary
+  slots$sampler_params <- sampler_params
   slots$nChains <- ncol(stanfit)
   slots$nIter <- nrow(samps_all) 
   slots$nWarmup <- nWarmup
   if (!missing(notes)) slots$user_model_info <- notes
   if (length(mcode) > 0) slots$model_code <- mcode
-  slots$misc <- list(max_td = max_td, stan_algorithm = stan_algorithm)
-  do.call("new", slots)
+  slots$misc <- list(max_td = max_td, stan_method = stan_method, 
+                     stan_algorithm = stan_algorithm)
+  sso <- do.call("new", slots)
+  .rename_scalar(sso)
 }
+