Changed extract_estimates argument order so the output from run() can…

R/hmde_extract_estimates.R

@@ -1,6 +1,5 @@
 #' Extract samples and return measurement, individual, and population-level estimates
 #'
-#' @param model model name character string
 #' @param fit fitted model Stan fit
 #' @param input_measurement_data data used to fit the model with ind_id, y_obs, time, obs_index tibble
 #'
@@ -9,8 +8,7 @@
 #' @import dplyr
 #' @importFrom stats quantile
 
-hmde_extract_estimates <- function(model = NULL,
-                                   fit = NULL,
+hmde_extract_estimates <- function(fit = NULL,
                                    input_measurement_data = NULL){
   #Check for fit
   if(is.null(fit)){
@@ -21,9 +19,11 @@ hmde_extract_estimates <- function(model = NULL,
     stop("Fit not S4 stanfit type.")
   }
 
+  model <- fit@model_name
   #Check for model
   if(!model %in% hmde_model_names()){
-    stop("Model name not recognised. Run hmde_model_names() to see available models.")
+    stop(paste0("Model name not recognised: ", model,
+                " Run hmde_model_names() to see available models."))
   }
 
   #Check for input measurement data
@@ -33,7 +33,7 @@ hmde_extract_estimates <- function(model = NULL,
     }
   }
 
-  estimate_list <- list()
+  estimate_list <- list(model_name = model)
   par_names <- hmde_model_pars(model)
 
   if(grepl("multi", model)){ #Get n_ind for multi-individual

inst/stan/affine_single_ind.stan

@@ -66,8 +66,8 @@ data {
   real time[n_obs];
   real y_bar;
   int int_method;
-  real prior_means[2]; #vector of means for beta parameter priors
-  real prior_sds[2]; #Vector of SDs for beta parameter priors
+  real prior_means[2]; //vector of means for beta parameter priors
+  real prior_sds[2]; //Vector of SDs for beta parameter priors
 }
 
 // The parameters accepted by the model.

tests/testthat/test-hmde_extract_estimates.R

@@ -7,16 +7,13 @@ test_that("Execution and output: extract_estimates function", {
   )
 
   suppressWarnings(
-    constant_single_fit <- hmde_model("constant_single_ind") |>
+    output <- hmde_model("constant_single_ind") |>
       hmde_assign_data(data = data) |>
       hmde_run(chains = 1, iter = 20, cores = 1,
-               verbose = FALSE, show_messages = FALSE)
+               verbose = FALSE, show_messages = FALSE) |>
+      hmde_extract_estimates(input_measurement_data = data)
   )
 
-  output <- hmde_extract_estimates(model = "constant_single_ind",
-                                   fit = constant_single_fit,
-                                   input_measurement_data = data)
-
   expect_named(output)
 
   expect_visible(output)

tests/testthat/test-hmde_plot_de_pieces.R

@@ -6,8 +6,7 @@ test_that("Execution and output: plot_de_pieces function", {
                verbose = FALSE, show_messages = FALSE)
   )
 
-  output <- hmde_extract_estimates(model = "constant_multi_ind",
-                                   fit = multi_ind_trout,
+  output <- hmde_extract_estimates(fit = multi_ind_trout,
                                    input_measurement_data = Trout_Size_Data)
 
   plot <- hmde_plot_de_pieces(model = "constant_multi_ind",
@@ -33,8 +32,7 @@ test_that("Execution and output: bad input", {
                verbose = FALSE, show_messages = FALSE)
   )
 
-  output <- hmde_extract_estimates(model = "constant_multi_ind",
-                                   fit = multi_ind_trout,
+  output <- hmde_extract_estimates(fit = multi_ind_trout,
                                    input_measurement_data = Trout_Size_Data)
 
   expect_error(

vignettes/canham.Rmd

@@ -83,8 +83,7 @@ tree_canham_fit <- hmde_model("canham_multi_ind") |>
   hmde_assign_data(data = Tree_Size_Data)  |>
   hmde_run(chains = 4, cores = 4, iter = 2000)
 
-tree_canham_estimates <- hmde_extract_estimates(model = "canham_multi_ind",
-                                 fit = tree_canham_fit,
+tree_canham_estimates <- hmde_extract_estimates(fit = tree_canham_fit,
                                  input_measurement_data = Tree_Size_Data)
 
 #saveRDS(tree_canham_fit, "tree_canham_fit.rds")

vignettes/constant-growth.Rmd

@@ -215,7 +215,7 @@ trout_constant_fit <- hmde_model("constant_multi_ind") |>
 Once the model has finished running, we can extract the model estimates and have a look at the distribution of estimated sizes, estimated growth increments, and annualised growth rates at the level of sizes over time.
 
 ```{r}
-trout_constant_estimates <- hmde_extract_estimates(model = "constant_multi_ind",
+trout_constant_estimates <- hmde_extract_estimates(                                 
                                  fit = trout_constant_fit,
                                  input_measurement_data = Trout_Size_Data)
 ```

vignettes/here_be_dragons.Rmd

@@ -167,8 +167,7 @@ for(i in 1:runs){
   )
 
   #Extract parameter estimates
-  ests <- hmde_extract_estimates(model = "affine_single_ind",
-                                 fit = fit,
+  ests <- hmde_extract_estimates(fit = fit,
                                  input_measurement_data = obs_data_frame)
 
   temp <- tibble(

vignettes/hmde_for_mathematicians.Rmd

@@ -104,8 +104,7 @@ canham_multi_ind_fit <- hmde_model("canham_multi_ind") |>
   hmde_assign_data(data = Tree_Size_Data)  |>
   hmde_run(chains = 1, cores = 1, iter = 1000)
 
-Tree_Size_Ests <- hmde_extract_estimates(model = "canham_multi_ind",
-                                 fit = canham_multi_ind_fit,
+Tree_Size_Ests <- hmde_extract_estimates(fit = canham_multi_ind_fit,
                                  input_measurement_data = Tree_Size_Data)
 ```
 

vignettes/von-bertalanffy.Rmd

@@ -100,8 +100,7 @@ lizard_vb_fit <- hmde_model("vb_multi_ind") |>
   hmde_assign_data(data = Lizard_Size_Data)  |>
   hmde_run(chains = 4, cores = 1, iter = 2000)
 
-lizard_estimates <- hmde_extract_estimates(model = "vb_multi_ind",
-                                           fit = lizard_vb_fit,
+lizard_estimates <- hmde_extract_estimates(fit = lizard_vb_fit,
                                            input_measurement_data = Lizard_Size_Data)
 ```