Skip to content

Commit

Permalink
Export LFMCMC (#27)
Browse files Browse the repository at this point in the history
* 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
apulsipher and gvegayon authored Nov 5, 2024
1 parent e2797fa commit 5b646c4
Show file tree
Hide file tree
Showing 30 changed files with 1,414 additions and 98 deletions.
2 changes: 2 additions & 0 deletions .devcontainer/Dockerfile
Original file line number Diff line number Diff line change
Expand Up @@ -10,4 +10,6 @@ RUN install2.r cpp11 roxygen2 tinytest data.table netplot \

RUN install2.r languageserver

RUN apt-get update && apt-get install --no-install-recommends -y valgrind gdb

CMD ["bash"]
3 changes: 3 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -20,3 +20,6 @@ src/Makevars
images
inst/doc
docs

config.log
config.status
3 changes: 2 additions & 1 deletion .vscode/settings.json
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,8 @@
"stdexcept": "cpp",
"streambuf": "cpp",
"typeinfo": "cpp",
"thread": "cpp"
"thread": "cpp",
"cinttypes": "cpp"
},
"editor.indentSize": "tabSize",
"[r]": {
Expand Down
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: epiworldR
Type: Package
Title: Fast Agent-Based Epi Models
Version: 0.3-2
Version: 0.4-3
Authors@R: c(
person(given="George", family="Vega Yon", role=c("aut","cre"),
email="g.vegayon@gmail.com", comment = c(ORCID = "0000-0002-3171-0844")),
Expand Down
11 changes: 8 additions & 3 deletions Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -46,9 +46,14 @@ clean:
sed -i -E 's/^library\(epiworldRdev\)/library(epiworldR)/g' README.*

docs:
Rscript --vanilla -e 'roxygen2::roxigenize()'

.PHONY: build update check clean docs docker-debug
Rscript --vanilla -e 'roxygen2::roxygenize()'

checkv: build
R CMD check --as-cran --use-valgrind epiworldR*.tar.gz

# Builds and installs without vignettes
dev: clean
R CMD build --no-build-vignettes .
R CMD INSTALL epiworldR_$(VERSION).tar.gz

.PHONY: build update check clean docs docker-debug dev
20 changes: 20 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,7 @@ S3method(print,epiworld_agents_tools)
S3method(print,epiworld_entities)
S3method(print,epiworld_entity)
S3method(print,epiworld_globalevent)
S3method(print,epiworld_lfmcmc)
S3method(print,epiworld_model)
S3method(print,epiworld_saver)
S3method(print,epiworld_tool)
Expand All @@ -73,13 +74,22 @@ S3method(queuing_on,epiworld_model)
S3method(queuing_on,epiworld_seirconn)
S3method(queuing_on,epiworld_sirconn)
S3method(run,epiworld_model)
S3method(run_lfmcmc,epiworld_lfmcmc)
S3method(run_multiple,epiworld_model)
S3method(set_kernel_fun,epiworld_lfmcmc)
S3method(set_name,epiworld_model)
S3method(set_observed_data,epiworld_lfmcmc)
S3method(set_par_names,epiworld_lfmcmc)
S3method(set_param,epiworld_model)
S3method(set_proposal_fun,epiworld_lfmcmc)
S3method(set_simulation_fun,epiworld_lfmcmc)
S3method(set_stats_names,epiworld_lfmcmc)
S3method(set_summary_fun,epiworld_lfmcmc)
S3method(size,epiworld_model)
S3method(summary,epiworld_model)
S3method(verbose_off,epiworld_model)
S3method(verbose_on,epiworld_model)
export(LFMCMC)
export(ModelDiffNet)
export(ModelSEIR)
export(ModelSEIRCONN)
Expand Down Expand Up @@ -167,6 +177,7 @@ export(rm_entity)
export(rm_tool)
export(rm_virus)
export(run)
export(run_lfmcmc)
export(run_multiple)
export(run_multiple_get_results)
export(set_agents_data)
Expand All @@ -179,9 +190,12 @@ export(set_distribution_virus)
export(set_incubation)
export(set_incubation_fun)
export(set_incubation_ptr)
export(set_kernel_fun)
export(set_name)
export(set_name_tool)
export(set_name_virus)
export(set_observed_data)
export(set_par_names)
export(set_param)
export(set_prob_death)
export(set_prob_death_fun)
Expand All @@ -192,9 +206,13 @@ export(set_prob_infecting_ptr)
export(set_prob_recovery)
export(set_prob_recovery_fun)
export(set_prob_recovery_ptr)
export(set_proposal_fun)
export(set_recovery_enhancer)
export(set_recovery_enhancer_fun)
export(set_recovery_enhancer_ptr)
export(set_simulation_fun)
export(set_stats_names)
export(set_summary_fun)
export(set_susceptibility_reduction)
export(set_susceptibility_reduction_fun)
export(set_susceptibility_reduction_ptr)
Expand All @@ -204,6 +222,8 @@ export(set_transmission_reduction_ptr)
export(size)
export(tool)
export(tool_fun_logit)
export(use_kernel_fun_gaussian)
export(use_proposal_norm_reflective)
export(verbose_off)
export(verbose_on)
export(virus)
Expand Down
216 changes: 216 additions & 0 deletions R/LFMCMC.R
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)
}
48 changes: 48 additions & 0 deletions R/cpp11.R
Original file line number Diff line number Diff line change
Expand Up @@ -220,6 +220,54 @@ ModelSEIRMixing_cpp <- function(name, n, prevalence, contact_rate, transmission_
.Call(`_epiworldR_ModelSEIRMixing_cpp`, name, n, prevalence, contact_rate, transmission_rate, incubation_days, recovery_rate, contact_matrix)
}

LFMCMC_cpp <- function(model) {
.Call(`_epiworldR_LFMCMC_cpp`, model)
}

run_lfmcmc_cpp <- function(lfmcmc, params_init_, n_samples_, epsilon_, seed) {
.Call(`_epiworldR_run_lfmcmc_cpp`, lfmcmc, params_init_, n_samples_, epsilon_, seed)
}

set_observed_data_cpp <- function(lfmcmc, observed_data_) {
.Call(`_epiworldR_set_observed_data_cpp`, lfmcmc, observed_data_)
}

set_proposal_fun_cpp <- function(lfmcmc, fun) {
.Call(`_epiworldR_set_proposal_fun_cpp`, lfmcmc, fun)
}

use_proposal_norm_reflective_cpp <- function(lfmcmc) {
.Call(`_epiworldR_use_proposal_norm_reflective_cpp`, lfmcmc)
}

set_simulation_fun_cpp <- function(lfmcmc, fun) {
.Call(`_epiworldR_set_simulation_fun_cpp`, lfmcmc, fun)
}

set_summary_fun_cpp <- function(lfmcmc, fun) {
.Call(`_epiworldR_set_summary_fun_cpp`, lfmcmc, fun)
}

set_kernel_fun_cpp <- function(lfmcmc, fun) {
.Call(`_epiworldR_set_kernel_fun_cpp`, lfmcmc, fun)
}

use_kernel_fun_gaussian_cpp <- function(lfmcmc) {
.Call(`_epiworldR_use_kernel_fun_gaussian_cpp`, lfmcmc)
}

set_par_names_cpp <- function(lfmcmc, names) {
.Call(`_epiworldR_set_par_names_cpp`, lfmcmc, names)
}

set_stats_names_cpp <- function(lfmcmc, names) {
.Call(`_epiworldR_set_stats_names_cpp`, lfmcmc, names)
}

print_lfmcmc_cpp <- function(lfmcmc) {
.Call(`_epiworldR_print_lfmcmc_cpp`, lfmcmc)
}

print_cpp <- function(m, lite) {
.Call(`_epiworldR_print_cpp`, m, lite)
}
Expand Down
Loading

0 comments on commit 5b646c4

Please sign in to comment.