Renaming variables for consistency with C++ library (#66)

* Update latest from C++ library

* Add C++ getters to R side

* Remove duplicate get_all_sample_stats

* Fix documentation error and update NAMESPACE

* Add tests for not passing LFMCMC to newly added functions

* Add tests for all new getters except get_all_sample_params

* Update with latest from C++ and add test for get_all_sample_params

* Update latest from C++ library

* Fix R package patch number and update tests

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: epiworldR
 Type: Package
 Title: Fast Agent-Based Epi Models
-Version: 0.6-0
+Version: 0.6-0.0
 Authors@R: c(
   person(given="George", family="Vega Yon", role=c("aut","cre"),
   email="[email protected]", comment = c(ORCID = "0000-0002-3171-0844")),

NAMESPACE

@@ -125,12 +125,22 @@ export(distribute_virus_set)
 export(entity)
 export(entity_add_agent)
 export(entity_get_agents)
-export(get_accepted_params)
-export(get_accepted_stats)
 export(get_agents)
 export(get_agents_data_ncols)
 export(get_agents_states)
 export(get_agents_tools)
+export(get_all_accepted_kernel_scores)
+export(get_all_accepted_params)
+export(get_all_accepted_stats)
+export(get_all_sample_acceptance)
+export(get_all_sample_drawn_prob)
+export(get_all_sample_kernel_scores)
+export(get_all_sample_params)
+export(get_all_sample_stats)
+export(get_current_accepted_params)
+export(get_current_accepted_stats)
+export(get_current_proposed_params)
+export(get_current_proposed_stats)
 export(get_entities)
 export(get_entity_name)
 export(get_entity_size)
@@ -139,6 +149,7 @@ export(get_hist_tool)
 export(get_hist_total)
 export(get_hist_transition_matrix)
 export(get_hist_virus)
+export(get_initial_params)
 export(get_mean_params)
 export(get_mean_stats)
 export(get_n_params)
@@ -152,9 +163,9 @@ export(get_name_tool)
 export(get_name_virus)
 export(get_ndays)
 export(get_network)
+export(get_observed_stats)
 export(get_param)
 export(get_reproductive_number)
-export(get_sample_stats)
 export(get_state)
 export(get_states)
 export(get_today_total)

R/LFMCMC.R

@@ -220,82 +220,110 @@ use_kernel_fun_gaussian <- function(lfmcmc) {
 }
 
 #' @rdname LFMCMC
-#' @param names Character vector of names.
 #' @returns
-#' - `set_params_names`: The lfmcmc model with the parameter names added.
+#' - `get_mean_params`: The param means for the given lfmcmc model.
 #' @export
-set_params_names <- function(lfmcmc, names) {
+get_mean_params <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  set_params_names_cpp(lfmcmc, names)
-  invisible(lfmcmc)
+  get_mean_params_cpp(lfmcmc)
 
 }
 
 #' @rdname LFMCMC
 #' @returns
-#' - `set_stats_names`: The lfmcmc model with the stats names added.
+#' - `get_mean_stats`: The stats means for the given lfmcmc model.
 #' @export
-set_stats_names <- function(lfmcmc, names) {
+get_mean_stats <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  set_stats_names_cpp(lfmcmc, names)
-  invisible(lfmcmc)
+  get_mean_stats_cpp(lfmcmc)
 
 }
 
 #' @rdname LFMCMC
+#' @export
 #' @returns
-#' - `get_mean_params`: The param means for the given lfmcmc model.
+#' - The function `get_initial_params` returns the initial parameters
+#' for the given LFMCMC model.
+get_initial_params <- function(lfmcmc) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  get_initial_params_cpp(lfmcmc)
+
+}
+
+#' @rdname LFMCMC
 #' @export
-get_mean_params <- function(lfmcmc) {
+#' @returns
+#' - The function `get_current_proposed_params` returns the proposed parameters
+#' for the next LFMCMC sample.
+get_current_proposed_params <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  get_mean_params_cpp(lfmcmc)
+  get_current_proposed_params_cpp(lfmcmc)
 
 }
 
 #' @rdname LFMCMC
+#' @export
 #' @returns
-#' - `get_mean_stats`: The stats means for the given lfmcmc model.
+#' - The function `get_current_accepted_params` returns the most recently accepted
+#' parameters (the current state of the LFMCMC)
+get_current_accepted_params <- function(lfmcmc) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  get_current_accepted_params_cpp(lfmcmc)
+
+}
+
+#' @rdname LFMCMC
 #' @export
-get_mean_stats <- function(lfmcmc) {
+#' @returns
+#' - The function `get_current_proposed_stats` returns the statistics
+#' from the simulation run with the proposed parameters
+get_current_proposed_stats <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  get_mean_stats_cpp(lfmcmc)
+  get_current_proposed_stats_cpp(lfmcmc)
 
 }
 
 #' @rdname LFMCMC
-#' @param x LFMCMC model to print
-#' @param ... Ignored
-#' @param burnin Integer. Number of samples to discard as burnin before
-#' computing the summary.
 #' @export
-print.epiworld_lfmcmc <- function(x, burnin = 0, ...) {
+#' @returns
+#' - The function `get_current_accepted_stats` returns the statistics
+#' from the most recently accepted parameters
+get_current_accepted_stats <- function(lfmcmc) {
 
-  if (!is.numeric(burnin))
-    stop("The 'burnin' argument must be an integer.")
+  stopifnot_lfmcmc(lfmcmc)
+  get_current_accepted_stats_cpp(lfmcmc)
 
-  if (burnin < 0)
-    stop("The 'burnin' argument must be a non-negative integer.")
+}
 
-  print_lfmcmc_cpp(x, burnin = burnin)
-  invisible(x)
+#' @rdname LFMCMC
+#' @export
+#' @returns
+#' - The function `get_observed_stats` returns the statistics
+#' for the observed data
+get_observed_stats <- function(lfmcmc) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  get_observed_stats_cpp(lfmcmc)
 
 }
 
 #' @rdname LFMCMC
 #' @export
 #' @returns
-#' - The function `get_accepted_params` returns a matrix of accepted
+#' - The function `get_all_sample_params` returns a matrix of sample
 #' parameters for the given LFMCMC model. with the number of rows equal to the
 #' number of samples and the number of columns equal to the number of
 #' parameters.
-get_accepted_params <- function(lfmcmc) {
+get_all_sample_params <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  a_params <- get_accepted_params_cpp(lfmcmc)
+  a_params <- get_all_sample_params_cpp(lfmcmc)
   n_params <- get_n_params(lfmcmc)
 
   matrix(
@@ -306,57 +334,126 @@ get_accepted_params <- function(lfmcmc) {
 
 }
 
-
-#' @rdname LFMCMC
 #' @export
+#' @rdname LFMCMC
 #' @returns
-#' - The function `get_accepted_stats` returns a matrix of accepted statistics
+#' - The function `get_all_sample_stats` returns a matrix of statistics
 #' for the given LFMCMC model. with the number of rows equal to the number of
 #' samples and the number of columns equal to the number of statistics.
-get_accepted_stats <- function(lfmcmc) {
+get_all_sample_stats <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  a_stats <- get_accepted_stats_cpp(lfmcmc)
+  stats <- get_all_sample_stats_cpp(lfmcmc)
   n_stats <- get_n_stats(lfmcmc)
 
   matrix(
-    a_stats,
+    stats,
     ncol = n_stats,
     byrow = TRUE
   )
 
 }
 
+#' @rdname LFMCMC
+#' @export
+#' @returns
+#' - The function `get_all_sample_acceptance` returns a vector of boolean flags
+#' which indicate whether a given sample was accepted
+get_all_sample_acceptance <- function(lfmcmc) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  get_all_sample_acceptance_cpp(lfmcmc)
+
+}
+
+#' @rdname LFMCMC
+#' @export
+#' @returns
+#' - The function `get_all_sample_drawn_prob` returns a vector of drawn probabilities
+#' for each sample
+get_all_sample_drawn_prob <- function(lfmcmc) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  get_all_sample_drawn_prob_cpp(lfmcmc)
+
+}
+
+#' @rdname LFMCMC
+#' @export
+#' @returns
+#' - The function `get_all_sample_kernel_scores` returns a vector of kernel scores for
+#' each sample
+get_all_sample_kernel_scores <- function(lfmcmc) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  get_all_sample_kernel_scores_cpp(lfmcmc)
+
+}
+
+#' @rdname LFMCMC
 #' @export
+#' @returns
+#' - The function `get_all_accepted_params` returns a matrix of accepted
+#' parameters for the given LFMCMC model. with the number of rows equal to the
+#' number of samples and the number of columns equal to the number of
+#' parameters.
+get_all_accepted_params <- function(lfmcmc) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  a_params <- get_all_accepted_params_cpp(lfmcmc)
+  n_params <- get_n_params(lfmcmc)
+
+  matrix(
+    a_params,
+    ncol = n_params,
+    byrow = TRUE
+  )
+
+}
+
+
 #' @rdname LFMCMC
+#' @export
 #' @returns
-#' - The function `get_sample_stats` returns a matrix of statistics
+#' - The function `get_all_accepted_stats` returns a matrix of accepted statistics
 #' for the given LFMCMC model. with the number of rows equal to the number of
 #' samples and the number of columns equal to the number of statistics.
-get_sample_stats <- function(lfmcmc) {
+get_all_accepted_stats <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  stats <- get_sample_stats_cpp(lfmcmc)
+  a_stats <- get_all_accepted_stats_cpp(lfmcmc)
   n_stats <- get_n_stats(lfmcmc)
 
   matrix(
-    stats,
+    a_stats,
     ncol = n_stats,
     byrow = TRUE
   )
 
 }
 
+#' @rdname LFMCMC
+#' @export
+#' @returns
+#' - The function `get_all_accepted_kernel_scores` returns a vector of kernel scores for
+#' each accepted sample
+get_all_accepted_kernel_scores <- function(lfmcmc) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  get_all_accepted_kernel_scores_cpp(lfmcmc)
+
+}
+
 #' @export
 #' @rdname LFMCMC
 #' @returns
-#' - The functions `get_n_params`, `get_n_stats`, and `get_n_samples`
-#' return the number of parameters, statistics, and samples for the given
+#' - The functions `get_n_samples`, `get_n_stats`, and `get_n_params`
+#' return the number of samples, statistics, and parameters for the given
 #' LFMCMC model, respectively.
-get_n_params <- function(lfmcmc) {
+get_n_samples <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  get_n_params_cpp(lfmcmc)
+  get_n_samples_cpp(lfmcmc)
 
 }
 
@@ -371,10 +468,10 @@ get_n_stats <- function(lfmcmc) {
 
 #' @export
 #' @rdname LFMCMC
-get_n_samples <- function(lfmcmc) {
+get_n_params <- function(lfmcmc) {
 
   stopifnot_lfmcmc(lfmcmc)
-  get_n_samples_cpp(lfmcmc)
+  get_n_params_cpp(lfmcmc)
 
 }
 
@@ -396,3 +493,47 @@ verbose_off.epiworld_lfmcmc <- function(x) {
 verbose_on.epiworld_lfmcmc <- function(x) {
   invisible(verbose_on_lfmcmc_cpp(x))
 }
+
+#' @rdname LFMCMC
+#' @param names Character vector of names.
+#' @returns
+#' - `set_params_names`: The lfmcmc model with the parameter names added.
+#' @export
+set_params_names <- function(lfmcmc, names) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  set_params_names_cpp(lfmcmc, names)
+  invisible(lfmcmc)
+
+}
+
+#' @rdname LFMCMC
+#' @returns
+#' - `set_stats_names`: The lfmcmc model with the stats names added.
+#' @export
+set_stats_names <- function(lfmcmc, names) {
+
+  stopifnot_lfmcmc(lfmcmc)
+  set_stats_names_cpp(lfmcmc, names)
+  invisible(lfmcmc)
+
+}
+
+#' @rdname LFMCMC
+#' @param x LFMCMC model to print
+#' @param ... Ignored
+#' @param burnin Integer. Number of samples to discard as burnin before
+#' computing the summary.
+#' @export
+print.epiworld_lfmcmc <- function(x, burnin = 0, ...) {
+
+  if (!is.numeric(burnin))
+    stop("The 'burnin' argument must be an integer.")
+
+  if (burnin < 0)
+    stop("The 'burnin' argument must be a non-negative integer.")
+
+  print_lfmcmc_cpp(x, burnin = burnin)
+  invisible(x)
+
+}