From 423e5f0c445b3b943faa7652f788d6e22be93cb8 Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Tue, 19 Nov 2024 21:37:17 -0700 Subject: [PATCH] Updating news file and correcting how seeds are set --- NEWS.md | 18 ++++++++++++++++++ R/LFMCMC.R | 48 +++++++++++++++++++++++++++++++++++++----------- man/LFMCMC.Rd | 9 ++++++--- src/lfmcmc.cpp | 9 +++++++-- 4 files changed, 68 insertions(+), 16 deletions(-) diff --git a/NEWS.md b/NEWS.md index d0be8221..6d273637 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,21 @@ +# epiworldR 0.4-3 (development version) + +## New features + +* The package now includes the `LFMCMC` module that implements + the likelihood-free Markov Chain Monte Carlo algorithm. This + module is used to estimate the parameters of the models. + +* The new function `add_param()` allows the user to add parameters + to the model. + +* The new function `rm_globalevent()` allows the user to remove + global events from the model. + +* The function `today()` returns the current day (step) of the + simulation. + + # epiworldR 0.3-2 * Starting version 0.3-0, `epiworldR` is versioned using the same version as the C++ library, `epiworld`. diff --git a/R/LFMCMC.R b/R/LFMCMC.R index b18ba818..43c69022 100644 --- a/R/LFMCMC.R +++ b/R/LFMCMC.R @@ -1,10 +1,12 @@ #' Likelihood-Free Markhov Chain Monte Carlo (LFMCMC) #' -#' #' @aliases epiworld_lfmcmc +#' @param model A model of class [epiworld_model] or `NULL` (see details). #' @details -#' Performs a Likelihood-Free Markhov Chain Monte Carlo simulation -#' @param model A model of class [epiworld_model] +#' Performs a Likelihood-Free Markhov Chain Monte Carlo simulation. When +#' `model` is not `NULL`, the model uses the same random-number generator +#' engine as the model. Otherwise, when `model` is `NULL`, a new random-number +#' generator engine is created. #' @returns #' The `LFMCMC` function returns a model of class [epiworld_lfmcmc]. #' @examples @@ -73,14 +75,19 @@ #' get_params_mean(lfmcmc_model) #' #' @export -LFMCMC <- function(model) { - if (!inherits(model, "epiworld_model")) - stop("model should be of class 'epiworld_model'. It is of class ", class(model)) +LFMCMC <- function(model = NULL) { + + if ((length(model) > 0) && !inherits(model, "epiworld_model")) + stop( + "model should be of class 'epiworld_model'. It is of class ", + paste(class(model), collapse = "\", ") + ) structure( LFMCMC_cpp(model), class = c("epiworld_lfmcmc") ) + } #' @rdname LFMCMC @@ -91,13 +98,28 @@ LFMCMC <- function(model) { #' @param seed Random engine seed #' @returns The simulated model of class [epiworld_lfmcmc]. #' @export -run_lfmcmc <- function(lfmcmc, params_init_, n_samples_, epsilon_, seed = NULL) UseMethod("run_lfmcmc") +run_lfmcmc <- function( + lfmcmc, params_init_, n_samples_, epsilon_, + seed = NULL + ) { + UseMethod("run_lfmcmc") +} #' @export -run_lfmcmc.epiworld_lfmcmc <- function(lfmcmc, params_init_, n_samples_, epsilon_, seed = NULL) { - if (length(seed)) set.seed(seed) - run_lfmcmc_cpp(lfmcmc, params_init_, n_samples_, epsilon_, sample.int(1e4, 1)) +run_lfmcmc.epiworld_lfmcmc <- function( + lfmcmc, params_init_, n_samples_, epsilon_, + seed = NULL + ) { + + if (length(seed)) + set.seed(seed) + + run_lfmcmc_cpp( + lfmcmc, params_init_, n_samples_, epsilon_, sample.int(1e4, 1) + ) + invisible(lfmcmc) + } #' @rdname LFMCMC @@ -105,7 +127,11 @@ run_lfmcmc.epiworld_lfmcmc <- function(lfmcmc, params_init_, n_samples_, epsilon #' @param observed_data_ Observed data #' @returns The lfmcmc model with the observed data added #' @export -set_observed_data <- function(lfmcmc, observed_data_) UseMethod("set_observed_data") +set_observed_data <- function( + lfmcmc, observed_data_ + ) { + UseMethod("set_observed_data") +} #' @export set_observed_data.epiworld_lfmcmc <- function(lfmcmc, observed_data_) { diff --git a/man/LFMCMC.Rd b/man/LFMCMC.Rd index 7e9204da..67765047 100644 --- a/man/LFMCMC.Rd +++ b/man/LFMCMC.Rd @@ -18,7 +18,7 @@ \alias{print.epiworld_lfmcmc} \title{Likelihood-Free Markhov Chain Monte Carlo (LFMCMC)} \usage{ -LFMCMC(model) +LFMCMC(model = NULL) run_lfmcmc(lfmcmc, params_init_, n_samples_, epsilon_, seed = NULL) @@ -47,7 +47,7 @@ get_stats_mean(lfmcmc) \method{print}{epiworld_lfmcmc}(x, ...) } \arguments{ -\item{model}{A model of class \link{epiworld_model}} +\item{model}{A model of class \link{epiworld_model} or \code{NULL} (see details).} \item{lfmcmc}{LFMCMC model} @@ -102,7 +102,10 @@ The lfmcmc model Likelihood-Free Markhov Chain Monte Carlo (LFMCMC) } \details{ -Performs a Likelihood-Free Markhov Chain Monte Carlo simulation +Performs a Likelihood-Free Markhov Chain Monte Carlo simulation. When +\code{model} is not \code{NULL}, the model uses the same random-number generator +engine as the model. Otherwise, when \code{model} is \code{NULL}, a new random-number +generator engine is created. } \examples{ ## Setup an SIR model to use in the simulation diff --git a/src/lfmcmc.cpp b/src/lfmcmc.cpp index 5b615c55..a22fffe4 100644 --- a/src/lfmcmc.cpp +++ b/src/lfmcmc.cpp @@ -29,8 +29,13 @@ SEXP LFMCMC_cpp( new LFMCMC() ); - cpp11::external_pointer> modelptr(model); - lfmcmc_ptr->set_rand_engine(modelptr->get_rand_endgine()); + if (Rf_inherits(model, "epiworld_model")) { + cpp11::external_pointer> modelptr(model); + lfmcmc_ptr->set_rand_engine(modelptr->get_rand_endgine()); + } else { + auto new_ptr = std::make_shared(std::mt19937()); + lfmcmc_ptr->set_rand_engine(new_ptr); + } return lfmcmc_ptr; }