rstan compatibility for n-mixtures

nicholasjclark · Feb 19, 2024 · b754c2d · b754c2d
1 parent 7db520e
commit b754c2d
Show file tree

Hide file tree

Showing 8 changed files with 22 additions and 8 deletions.
diff --git a/R/add_nmixture.R b/R/add_nmixture.R
@@ -489,11 +489,23 @@ add_nmix_posterior = function(model_output,
     samp_starts <- seq(1, NROW(samples), by = nsamples)
     samp_ends <- seq(nsamples, NROW(samples), by = nsamples)
     for(i in 1:nchains){
+
       samps_df <- data.frame(samples[samp_starts[i]:samp_ends[i],])
       colnames(samps_df) <- names
-      model_output@sim$samples[[i]] <-
-        dplyr::bind_cols(model_output@sim$samples[[i]],
-                         samps_df)
+
+      if(is.list(model_output@sim$samples[[i]])){
+        old <- attributes(model_output@sim$samples[[i]])
+        oldnames <- attr(model_output@sim$samples[[i]], 'names')
+        model_output@sim$samples[[i]] <-
+          append(model_output@sim$samples[[i]], as.list(samps_df))
+        mostattributes(model_output@sim$samples[[i]]) <- old
+        attr(model_output@sim$samples[[i]], 'names') <-
+          c(oldnames, colnames(samps_df))
+      } else {
+        model_output@sim$samples[[i]] <-
+          dplyr::bind_cols(model_output@sim$samples[[i]],
+                           samps_df)
+      }
     }
     model_output@sim$fnames_oi <- c(model_output@sim$fnames_oi,
                                            names)
@@ -638,11 +650,11 @@ add_nmix_posterior = function(model_output,
 
   # Add latent_ypreds to the posterior samples
   model_output <- add_samples(model_output = model_output,
-                        names = gsub('trend', 'latent_ypred', parnames),
-                        samples = latentypreds[, indices],
-                        nsamples = NROW(latentypreds) / nchains,
-                        nchains = nchains,
-                        parname = 'latent_ypred')
+                              names = gsub('trend', 'latent_ypred', parnames),
+                              samples = latentypreds[, indices],
+                              nsamples = NROW(latentypreds) / nchains,
+                              nchains = nchains,
+                              parname = 'latent_ypred')
   model_output@sim$dims_oi$latent_ypred <-
     model_output@sim$dims_oi$trend
 

diff --git a/R/mvgam.R b/R/mvgam.R
@@ -2129,6 +2129,7 @@ mvgam = function(formula,
                                     control = stan_control,
                                     pars = NA,
                                     refresh = 100,
+                                    save_warmup = FALSE,
                                     ...)
           } else {
             fit1 <- rstan::sampling(stan_mod,
@@ -2143,6 +2144,7 @@ mvgam = function(formula,
                                     control = stan_control,
                                     pars = NA,
                                     refresh = 100,
+                                    save_warmup = FALSE,
                                     ...)
           }
         }

diff --git a/docs/articles/nmixtures_files/figure-html/unnamed-chunk-13-1.png b/docs/articles/nmixtures_files/figure-html/unnamed-chunk-13-1.png
diff --git a/docs/articles/nmixtures_files/figure-html/unnamed-chunk-13-2.png b/docs/articles/nmixtures_files/figure-html/unnamed-chunk-13-2.png
diff --git a/src/RcppExports.o b/src/RcppExports.o
diff --git a/src/mvgam.dll b/src/mvgam.dll
diff --git a/src/trend_funs.o b/src/trend_funs.o
diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf