-
Notifications
You must be signed in to change notification settings - Fork 3
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
* Create LFMCMC.R and lfmcmc.cpp * Fix pre-commit style failures * Using tidyverse 4.4.0 as base dev image * Fix roxygenize typo in Makefile * Run 'make docs' and add cpp11, NAMESPACE, and roxygen files * Add config.log and config.status to gitignore * Run pre-commit on existing docs files * Add epiworld_double macro to Makevars * Add run method to LFMCMC * Add set_observed_data to LFMCMC * Add set_proposal_fun, set_simulation_fun, set_summary_fun, and set_kernel_fun * Document LFMCMC functions * Add basic example and try resolving generic run class warning * Run roxygen2 on LFMCMC * Rename LFMCMC run function to run_lfmcmc * Add epiworld_double macro to Makevars.win * Create likelihood-free0mcmc.Rmd * Add TODO tags to mark needed work * Add seed, set_param_nams_, set_stats_names, print to lfmcmc * Update documentation on LFMCMC * Document params for print.epiworld_lfmcmc * Setup function ordering for likelihood-free-mcmc.Rmd * Make lfmcmc vignette simpler to start * Add set_simulation_fun in lfmcmc vignette * Try vignette without piping * Add UseMethod export for base version of LFMCMC class methods * Clean up vignette to separate failing block * Add create_LFMCMCMSimFun_cpp() * Add lambda return type * Fix lambda param mismatch with LFMCMCMSimFun and set correctly in se_simulation_fun_cpp * Add factory methods for summary, proposal, kernel functions * Add set_rand_engine function and update constructor to extract rand_engine from model * Document param in updated LFMCMC constructor * Update LFMCMC example in .R file * Make lfmcmc constructor more readable * Add factory methods for norm_reflective proposal function and gaussian kernel function * Delete prop and kernel function defs after using factory methods * Add cinttypes to .vscode/settings.json * Minor tweaks to lfmcmc vignette simfun * Minor changes and adding valgrind to docker * Add simpler use proposal/kernel functions * Clean up create sum and create sim fun in lfmcmc.cpp * Remove 'create' lfmcmc methods to instead create the function within the 'set' methods and add temp test code * New version of epiworld * Getting closer * Updating epiworld * Sync with latest version of epiworld * Add dev option to Makefile to build and install without vignettes * Now is running * Changing param * Clean up Makefile * Clean up comments and unneed function * Clean up LFMCMC vignette * Remove second parameter in R version of simulation and summary functions * Restore seed_lfmcmc_cpp() * Cleaning up files * Sync with C++ epiworld library * Remove seed_lfmcmc * Add seed to run_lfmcmc * Update LFMCMC.R to match order of lfmcmc.cpp * Add comment blocks to lfmcmc.cpp to improve file navigation * Implement set_kernel_fun * Implement set_proposal_fun * Update comments in vignette * Sync with c++ library * Fill out fields for roxygen docs of LFMCMC * Create test-lfmcmc.R and populate with example from vignette * Sync with C++ epiworld library * Sync with c++ epiworld library * Update version number to match C++ library --------- Co-authored-by: George G. Vega Yon <g.vegayon@gmail.com>
- Loading branch information
1 parent
e2797fa
commit 5b646c4
Showing
30 changed files
with
1,414 additions
and
98 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -20,3 +20,6 @@ src/Makevars | |
images | ||
inst/doc | ||
docs | ||
|
||
config.log | ||
config.status |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,216 @@ | ||
#' Likelihood-Free Markhov Chain Monte Carlo (LFMCMC) | ||
#' | ||
#' | ||
#' @aliases epiworld_lfmcmc | ||
#' @details | ||
#' Performs a Likelihood-Free Markhov Chain Monte Carlo simulation | ||
#' @param model A model of class [epiworld_model] | ||
#' @returns | ||
#' The `LFMCMC` function returns a model of class [epiworld_lfmcmc]. | ||
#' @examples | ||
#' ## Setup an SIR model to use in the simulation | ||
#' model_seed <- 122 | ||
#' model_sir <- ModelSIR(name = "COVID-19", prevalence = .1, | ||
#' transmission_rate = .9, recovery_rate = .3) | ||
#' agents_smallworld( | ||
#' model_sir, | ||
#' n = 1000, | ||
#' k = 5, | ||
#' d = FALSE, | ||
#' p = 0.01 | ||
#' ) | ||
#' verbose_off(model_sir) | ||
#' run(model_sir, ndays = 50, seed = model_seed) | ||
#' | ||
#' ## Setup LFMCMC | ||
#' # Extract the observed data from the model | ||
#' obs_data <- unname(as.integer(get_today_total(model_sir))) | ||
#' | ||
#' # Define the simulation function | ||
#' simfun <- function(params) { | ||
#' set_param(model_sir, "Recovery rate", params[1]) | ||
#' set_param(model_sir, "Transmission rate", params[2]) | ||
#' run(model_sir, ndays = 50) | ||
#' res <- unname(as.integer(get_today_total(model_sir))) | ||
#' return(res) | ||
#' } | ||
#' | ||
#' # Define the summary function | ||
#' sumfun <- function(dat) { | ||
#' return(dat) | ||
#' } | ||
#' | ||
#' # Create the LFMCMC model | ||
#' lfmcmc_model <- LFMCMC(model_sir) |> | ||
#' set_simulation_fun(simfun) |> | ||
#' set_summary_fun(sumfun) |> | ||
#' use_proposal_norm_reflective() |> | ||
#' use_kernel_fun_gaussian() |> | ||
#' set_observed_data(obs_data) | ||
#' | ||
#' ## Run LFMCMC simulation | ||
#' # Set initial parameters | ||
#' par0 <- as.double(c(0.1, 0.5)) | ||
#' n_samp <- 2000 | ||
#' epsil <- as.double(1.0) | ||
#' | ||
#' # Run the LFMCMC simulation | ||
#' run_lfmcmc( | ||
#' lfmcmc = lfmcmc_model, | ||
#' params_init_ = par0, | ||
#' n_samples_ = n_samp, | ||
#' epsilon_ = epsil, | ||
#' seed = model_seed | ||
#' ) | ||
#' | ||
#' # Print the results | ||
#' set_stats_names(lfmcmc_model, get_states(model_sir)) | ||
#' set_par_names(lfmcmc_model, c("Immune recovery", "Infectiousness")) | ||
#' | ||
#' print(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)) | ||
|
||
structure( | ||
LFMCMC_cpp(model), | ||
class = c("epiworld_lfmcmc") | ||
) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc LFMCMC model | ||
#' @param params_init_ Initial model parameters | ||
#' @param n_samples_ Number of samples | ||
#' @param epsilon_ Epsilon parameter | ||
#' @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") | ||
|
||
#' @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)) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc LFMCMC model | ||
#' @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") | ||
|
||
#' @export | ||
set_observed_data.epiworld_lfmcmc <- function(lfmcmc, observed_data_) { | ||
set_observed_data_cpp(lfmcmc, observed_data_) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc LFMCMC model | ||
#' @param fun The LFMCMC proposal function | ||
#' @returns The lfmcmc model with the proposal function added | ||
#' @export | ||
set_proposal_fun <- function(lfmcmc, fun) UseMethod("set_proposal_fun") | ||
|
||
#' @export | ||
set_proposal_fun.epiworld_lfmcmc <- function(lfmcmc, fun) { | ||
set_proposal_fun_cpp(lfmcmc, fun) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc The LFMCMC model | ||
#' @returns The LFMCMC model with proposal function set to norm reflective | ||
#' @export | ||
use_proposal_norm_reflective <- function(lfmcmc) { | ||
use_proposal_norm_reflective_cpp(lfmcmc) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc LFMCMC model | ||
#' @param fun The LFMCMC simulation function | ||
#' @returns The lfmcmc model with the simulation function added | ||
#' @export | ||
set_simulation_fun <- function(lfmcmc, fun) UseMethod("set_simulation_fun") | ||
|
||
#' @export | ||
set_simulation_fun.epiworld_lfmcmc <- function(lfmcmc, fun) { | ||
set_simulation_fun_cpp(lfmcmc, fun) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc LFMCMC model | ||
#' @param fun The LFMCMC sumamry function | ||
#' @returns The lfmcmc model with the summary function added | ||
#' @export | ||
set_summary_fun <- function(lfmcmc, fun) UseMethod("set_summary_fun") | ||
|
||
#' @export | ||
set_summary_fun.epiworld_lfmcmc <- function(lfmcmc, fun) { | ||
set_summary_fun_cpp(lfmcmc, fun) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc LFMCMC model | ||
#' @param fun The LFMCMC kernel function | ||
#' @returns The lfmcmc model with the kernel function added | ||
#' @export | ||
set_kernel_fun <- function(lfmcmc, fun) UseMethod("set_kernel_fun") | ||
|
||
#' @export | ||
set_kernel_fun.epiworld_lfmcmc <- function(lfmcmc, fun) { | ||
set_kernel_fun_cpp(lfmcmc, fun) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc The LFMCMC model | ||
#' @returns The LFMCMC model with kernel function set to gaussian | ||
#' @export | ||
use_kernel_fun_gaussian <- function(lfmcmc) { | ||
use_kernel_fun_gaussian_cpp(lfmcmc) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc LFMCMC model | ||
#' @param names The model parameter names | ||
#' @returns The lfmcmc model with the parameter names added | ||
#' @export | ||
set_par_names <- function(lfmcmc, names) UseMethod("set_par_names") | ||
|
||
#' @export | ||
set_par_names.epiworld_lfmcmc <- function(lfmcmc, names) { | ||
set_par_names_cpp(lfmcmc, names) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param lfmcmc LFMCMC model | ||
#' @param names The model stats names | ||
#' @returns The lfmcmc model with the stats names added | ||
#' @export | ||
set_stats_names <- function(lfmcmc, names) UseMethod("set_stats_names") | ||
|
||
#' @export | ||
set_stats_names.epiworld_lfmcmc <- function(lfmcmc, names) { | ||
set_stats_names_cpp(lfmcmc, names) | ||
invisible(lfmcmc) | ||
} | ||
|
||
#' @rdname LFMCMC | ||
#' @param x LFMCMC model to print | ||
#' @param ... Ignored | ||
#' @returns The lfmcmc model | ||
#' @export | ||
print.epiworld_lfmcmc <- function(x, ...) { | ||
print_lfmcmc_cpp(x) | ||
invisible(x) | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.