Add verbose_on/off functions to lfmcmc to enable/disable progress bar

UofUEpiBio · Dec 12, 2024 · 73b4d2f · 73b4d2f
1 parent 167895e
commit 73b4d2f
Show file tree

Hide file tree

Showing 8 changed files with 90 additions and 0 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -83,7 +83,9 @@ S3method(set_param,epiworld_model)
 S3method(size,epiworld_model)
 S3method(summary,epiworld_model)
 S3method(today,epiworld_model)
+S3method(verbose_off,epiworld_lfmcmc)
 S3method(verbose_off,epiworld_model)
+S3method(verbose_on,epiworld_lfmcmc)
 S3method(verbose_on,epiworld_model)
 export(LFMCMC)
 export(ModelDiffNet)

diff --git a/R/LFMCMC.R b/R/LFMCMC.R
@@ -67,6 +67,7 @@ stopifnot_lfmcmc <- function(x) {
 #' epsil <- 1.0
 #'
 #' # Run the LFMCMC simulation
+#' verbose_off(lfmcmc_model)
 #' run_lfmcmc(
 #'   lfmcmc = lfmcmc_model,
 #'   params_init_ = par0,
@@ -382,3 +383,22 @@ get_n_samples <- function(lfmcmc) {
   get_n_samples_cpp(lfmcmc)
 
 }
+
+#' @rdname LFMCMC
+#' @export
+#' @returns
+#' - The `verbose_on` and `verbose_off` functions return the same model, however
+#' `verbose_off` returns the model with no progress bar.
+#' @details
+#' The `verbose_on` and `verbose_off` functions activate and deactivate printing
+#' progress on screen, respectively. Both functions return the model (`x`) invisibly.
+
+#' @export
+verbose_off.epiworld_lfmcmc <- function(x) {
+  invisible(verbose_off_lfmcmc_cpp(x))
+}
+
+#' @export
+verbose_on.epiworld_lfmcmc <- function(x) {
+  invisible(verbose_on_lfmcmc_cpp(x))
+}
diff --git a/R/cpp11.R b/R/cpp11.R
@@ -300,6 +300,14 @@ get_n_params_cpp <- function(lfmcmc) {
   .Call(`_epiworldR_get_n_params_cpp`, lfmcmc)
 }
 
+verbose_off_lfmcmc_cpp <- function(lfmcmc) {
+  .Call(`_epiworldR_verbose_off_lfmcmc_cpp`, lfmcmc)
+}
+
+verbose_on_lfmcmc_cpp <- function(lfmcmc) {
+  .Call(`_epiworldR_verbose_on_lfmcmc_cpp`, lfmcmc)
+}
+
 print_cpp <- function(m, lite) {
   .Call(`_epiworldR_print_cpp`, m, lite)
 }

diff --git a/inst/tinytest/test-lfmcmc.R b/inst/tinytest/test-lfmcmc.R
@@ -60,6 +60,7 @@ par0 <- c(0.1, 0.5)
 n_samp <- 2000
 epsil <- 1.0
 
+expect_silent(verbose_off(lfmcmc_model))
 expect_silent(run_lfmcmc(
   lfmcmc = lfmcmc_model,
   params_init_ = par0,
@@ -79,6 +80,17 @@ expect_error(print(lfmcmc_model, burnin = n_samp + 50), "burnin is greater than
 expect_error(print(lfmcmc_model, burnin = -n_samp / 2), "argument must be a non-negative integer")
 expect_error(print(lfmcmc_model, burnin = "n_samp"), "argument must be an integer")
 
+# Check verbose_on -------------------------------------------------------------
+expect_silent(verbose_on(lfmcmc_model))
+expect_stdout(run_lfmcmc(
+  lfmcmc = lfmcmc_model,
+  params_init_ = par0,
+  n_samples_ = n_samp,
+  epsilon_ = epsil,
+  seed = model_seed
+))
+verbose_off(lfmcmc_model)
+
 # Check LFMCMC getters ---------------------------------------------------------
 expect_equal(get_n_samples(lfmcmc_model), n_samp)
 
@@ -196,6 +208,7 @@ lfmcmc_model <- LFMCMC() |>
   set_observed_data(Y)
 
 # Run LFMCMC
+verbose_off(lfmcmc_model)
 x <- run_lfmcmc(
   lfmcmc = lfmcmc_model,
   params_init_ = c(0, 1),

diff --git a/man/LFMCMC.Rd b/man/LFMCMC.Rd
diff --git a/src/cpp11.cpp b/src/cpp11.cpp
@@ -530,6 +530,20 @@ extern "C" SEXP _epiworldR_get_n_params_cpp(SEXP lfmcmc) {
     return cpp11::as_sexp(get_n_params_cpp(cpp11::as_cpp<cpp11::decay_t<SEXP>>(lfmcmc)));
   END_CPP11
 }
+// lfmcmc.cpp
+SEXP verbose_off_lfmcmc_cpp(SEXP lfmcmc);
+extern "C" SEXP _epiworldR_verbose_off_lfmcmc_cpp(SEXP lfmcmc) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(verbose_off_lfmcmc_cpp(cpp11::as_cpp<cpp11::decay_t<SEXP>>(lfmcmc)));
+  END_CPP11
+}
+// lfmcmc.cpp
+SEXP verbose_on_lfmcmc_cpp(SEXP lfmcmc);
+extern "C" SEXP _epiworldR_verbose_on_lfmcmc_cpp(SEXP lfmcmc) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(verbose_on_lfmcmc_cpp(cpp11::as_cpp<cpp11::decay_t<SEXP>>(lfmcmc)));
+  END_CPP11
+}
 // model.cpp
 SEXP print_cpp(SEXP m, bool lite);
 extern "C" SEXP _epiworldR_print_cpp(SEXP m, SEXP lite) {
@@ -1212,7 +1226,9 @@ static const R_CallMethodDef CallEntries[] = {
     {"_epiworldR_use_kernel_fun_gaussian_cpp",          (DL_FUNC) &_epiworldR_use_kernel_fun_gaussian_cpp,           1},
     {"_epiworldR_use_proposal_norm_reflective_cpp",     (DL_FUNC) &_epiworldR_use_proposal_norm_reflective_cpp,      1},
     {"_epiworldR_verbose_off_cpp",                      (DL_FUNC) &_epiworldR_verbose_off_cpp,                       1},
+    {"_epiworldR_verbose_off_lfmcmc_cpp",               (DL_FUNC) &_epiworldR_verbose_off_lfmcmc_cpp,                1},
     {"_epiworldR_verbose_on_cpp",                       (DL_FUNC) &_epiworldR_verbose_on_cpp,                        1},
+    {"_epiworldR_verbose_on_lfmcmc_cpp",                (DL_FUNC) &_epiworldR_verbose_on_lfmcmc_cpp,                 1},
     {"_epiworldR_virus_cpp",                            (DL_FUNC) &_epiworldR_virus_cpp,                             8},
     {"_epiworldR_virus_fun_logit_cpp",                  (DL_FUNC) &_epiworldR_virus_fun_logit_cpp,                   3},
     {"_epiworldR_virus_set_state_cpp",                  (DL_FUNC) &_epiworldR_virus_set_state_cpp,                   4},

diff --git a/src/lfmcmc.cpp b/src/lfmcmc.cpp
@@ -305,4 +305,22 @@ int get_n_params_cpp(SEXP lfmcmc) {
 
 }
 
+[[cpp11::register]]
+SEXP verbose_off_lfmcmc_cpp(SEXP lfmcmc) {
+
+  WrapLFMCMC(lfmcmc_ptr)(lfmcmc);
+  lfmcmc_ptr->verbose_off();
+  return lfmcmc;
+
+}
+
+[[cpp11::register]]
+SEXP verbose_on_lfmcmc_cpp(SEXP lfmcmc) {
+
+  WrapLFMCMC(lfmcmc_ptr)(lfmcmc);
+  lfmcmc_ptr->verbose_on();
+  return lfmcmc;
+
+}
+
 #undef WrapLFMCMC
diff --git a/vignettes/likelihood-free-mcmc.Rmd b/vignettes/likelihood-free-mcmc.Rmd
@@ -108,6 +108,7 @@ n_samp <- 2000
 epsil <- 1.0
 
 # Run the LFMCMC simulation
+verbose_off(lfmcmc_model)
 run_lfmcmc(
   lfmcmc = lfmcmc_model,
   params_init_ = par0,