Merge pull request #207 from stan-dev/CmdStanMCMC_CSV

as.shinystan compatibility with cmdstanr::as_cmdstan_fit

Author: jgabry

DESCRIPTION

@@ -63,4 +63,4 @@ Additional_repositories:
 LazyData: true
 Encoding: UTF-8
 VignetteBuilder: knitr
-RoxygenNote: 7.1.2
+RoxygenNote: 7.3.3

R/shinystan-objects.R

@@ -870,49 +870,64 @@ setMethod(
 
 
 # as.shinystan (CmdStanMCMC) -----------------------------------------------
+as.shinystan_cmdstanr <- function(X,
+                                  pars = NULL,
+                                  model_name = NULL,
+                                  note = NULL,
+                                  ...) {
+  check_suggests("cmdstanr")
+  check_suggests("posterior")
+  if (is.null(model_name) && !is.null(X$runset)) {
+    model_name <- X$runset$model_name()
+  } else {
+    model_name <- "unnamed model"
+  }
+  
+  if (X$metadata()$save_warmup == 0) {
+    draws <- unclass(X$draws(pars))
+    sampler_diagnostics <- X$sampler_diagnostics()
+    n_warmup <- 0
+  } else {
+    draws <- unclass(X$draws(pars, inc_warmup = TRUE))
+    sampler_diagnostics <- X$sampler_diagnostics(inc_warmup = TRUE)
+    n_warmup <- X$metadata()$iter_warmup
+  }
+  
+  sampler_params <- list()
+  for (j in seq_len(dim(sampler_diagnostics)[2])) {
+    sampler_params[[j]] <- posterior::as_draws_matrix(sampler_diagnostics[, j ,])
+  }
+  
+  as.shinystan(
+    draws,
+    model_name = model_name,
+    warmup = n_warmup,
+    param_dims = X$metadata()$stan_variable_dims,
+    model_code = NULL,
+    note = note,
+    sampler_params = sampler_params, 
+    algorithm = "NUTS",
+    max_treedepth = X$metadata()$max_treedepth
+  )
+}
+
 setOldClass("CmdStanMCMC")
 #' @describeIn as.shinystan Create a \code{shinystan} object from a 
 #'   \code{CmdStanMCMC} object (\pkg{cmdstanr}).
 #' 
 setMethod(
   "as.shinystan",
   signature = "CmdStanMCMC",
-  definition = function(X,
-                        pars = NULL,
-                        model_name = NULL,
-                        note = NULL,
-                        ...) {
-    check_suggests("cmdstanr")
-    check_suggests("posterior")
-    if (is.null(model_name)) {
-      model_name <- X$runset$model_name()
-    }
-    
-    if (X$metadata()$save_warmup == 0) {
-      draws <- unclass(X$draws(pars))
-      sampler_diagnostics <- X$sampler_diagnostics()
-      n_warmup <- 0
-    } else {
-      draws <- unclass(X$draws(pars, inc_warmup = TRUE))
-      sampler_diagnostics <- X$sampler_diagnostics(inc_warmup = TRUE)
-      n_warmup <- X$metadata()$iter_warmup
-    }
-    
-    sampler_params <- list()
-    for (j in seq_len(dim(sampler_diagnostics)[2])) {
-      sampler_params[[j]] <- posterior::as_draws_matrix(sampler_diagnostics[, j ,])
-    }
-    
-    as.shinystan(
-      draws,
-      model_name = model_name,
-      warmup = n_warmup,
-      param_dims = X$metadata()$stan_variable_dims,
-      model_code = NULL,
-      note = note,
-      sampler_params = sampler_params, 
-      algorithm = "NUTS",
-      max_treedepth = X$metadata()$max_treedepth
-    )
-  }
+  definition = as.shinystan_cmdstanr
+)
+
+setOldClass("CmdStanMCMC_CSV")
+#' @describeIn as.shinystan Create a \code{shinystan} object from a
+#'   \code{CmdStanMCMC_CSV} object created using
+#'   \code{cmdstanr::as_cmdstan_fit()} (\pkg{cmdstanr}).
+#' 
+setMethod(
+  "as.shinystan",
+  signature = "CmdStanMCMC_CSV",
+  definition = as.shinystan_cmdstanr
 )

inst/ShinyStan/ui_utils.R

@@ -36,7 +36,7 @@ logo_and_name <- function() {
     ),
     div(
       style = "margin-top: 25px",
-      img(src = "stan_logo.svg", class = "stan-logo"),
+      img(src = "stan_logo.png", class = "stan-logo"),
       div(id = "shinystan-title", "ShinyStan")
     )
   )

tests/testthat/test_creating_sso.R

@@ -204,6 +204,8 @@ test_that("as.shinystan works with CmdStanMCMC objects", {
     expect_equal(sso@param_names, c("log-posterior", "mu", "tau", paste0("theta[", 1:8, "]")))
     expect_equal(sso@n_chain, 2)
     expect_equal(sso@n_warmup, 500)
+    
+    expect_no_error(sso2 <- as.shinystan(cmdstanr::as_cmdstan_fit(fit$output_files())))
   }
 })