diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 index e70bb306..00000000 Binary files a/.DS_Store and /dev/null differ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index fe773b7a..70ca28f1 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -11,8 +11,6 @@ on: - feat/* - bug/* -name: R-CMD-check - jobs: R-CMD-check: runs-on: ${{ matrix.config.os }} @@ -26,20 +24,21 @@ jobs: - {os: windows-latest, r: 'release'} - {os: macOS-latest, r: 'release'} - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest", http-user-agent: "R/4.1.0 (ubuntu-20.04) R (4.1.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" } env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true RSPM: ${{ matrix.config.rspm }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/setup-r@master + - uses: r-lib/actions/setup-r@v1 with: r-version: ${{ matrix.config.r }} - - uses: r-lib/actions/setup-pandoc@master + - uses: r-lib/actions/setup-pandoc@v1 - name: Query dependencies run: | @@ -48,40 +47,33 @@ jobs: writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") shell: Rscript {0} - - name: Cache R packages - if: runner.os != 'Windows' - uses: actions/cache@v1 + - name: Restore R package cache + uses: actions/cache@v2 with: path: ${{ env.R_LIBS_USER }} key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- + - name: Install system dependencies if: runner.os == 'Linux' run: | - set -x while read -r cmd do eval sudo $cmd - done < <(Rscript -e 'cat(remotes::system_requirements("ubuntu", "20.04"), sep = "\n")') + done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') - name: Install dependencies run: | - install.packages(c("remotes")) remotes::install_deps(dependencies = TRUE) remotes::install_cran("rcmdcheck") shell: Rscript {0} - - name: Install vignette dependencies - if: runner.os == 'Windows' - run: | - install.packages(".", repos=NULL, type="source") - shell: Rscript {0} - - - name: Check env: _R_CHECK_CRAN_INCOMING_REMOTE_: false - run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") + run: | + options(crayon.enabled = TRUE) + rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") shell: Rscript {0} - name: Upload check results @@ -89,4 +81,4 @@ jobs: uses: actions/upload-artifact@main with: name: ${{ runner.os }}-r${{ matrix.config.r }}-results - path: check + path: check \ No newline at end of file diff --git a/.gitignore b/.gitignore index e8bdbc2a..fb951c1b 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,30 @@ doc Meta /doc/ /Meta/ + +# General +.DS_Store +.AppleDouble +.LSOverride + +# Icon must end with two \r +Icon + +# Thumbnails +._* + +# Files that might appear in the root of a volume +.DocumentRevisions-V100 +.fseventsd +.Spotlight-V100 +.TemporaryItems +.Trashes +.VolumeIcon.icns +.com.apple.timemachine.donotpresent + +# Directories potentially created on remote AFP share +.AppleDB +.AppleDesktop +Network Trash Folder +Temporary Items +.apdisk \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index 6bc75166..a5d24a80 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: individual Title: Framework for Specifying and Simulating Individual Based Models -Version: 0.1.5 +Version: 0.1.6 Authors@R: c( person( given = "Giovanni", diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 00000000..77bbcb04 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,45 @@ +# individual 0.1.6 + + * Added a `NEWS.md` file to track changes to the package. + * Add Mac OS files to .gitignore + * Update pkgdown reference organization. + * Update [R-CMD-check workflow](https://github.com/r-lib/actions/tree/master/examples#standard-ci-workflow). + * `Event.h` now defines class methods outside of the class definition for + easier readability, and add documentation. + * `TargetedEvent$schedule` now dispatches to different C++ functions in `event.cpp` + and `Event.h` depending on if input index is a bitset or vector (previous + behavior used bitset's $to_vector$ method in R to pass a vector). + * `test-event.R` now only contains tests for `Event` class, new test file + `test-targetedevent.R` contains a much updated suite of tests for the + `TargetedEvent` class. + * Fix bug where `CategoricalVariable` could be queued updates for indices in + a vector that were outside the range of the population. + * Update `Bitset$not` to operate in place. inplace = FALSE will be deprecated + in 0.2.0 + * Rename the IterableBitset ~ operator to ! + +# individual 0.1.5 + + * Added package logo. + * Update DESCRIPTION and remove "reshape2" from suggested packages. + * If given a `Bitset` for argument `index`, `queue_update` methods for + `IntegerVariable` and `DoubleVariable` pass the bitset directly to the C++ + functions `integer_variable_queue_update_bitset` and `double_variable_queue_update_bitset` + rather than converting to vector and using vector methods. + * `CategoricalVariable.h`, `IntegerVariable.h`, and `DoubleVariable.h` now define + class methods outside of the class definition for easier readability, and add + documentation. + * `CategoricalVariable`, `IntegerVariable`, and `DoubleVariable` classes define + a virtual destructor with default implementation. + * `get_index_of_set` and `get_size_of_set_vector` methods for `IntegerVariable` + now pass arguments by reference. + * `get_values` method for `IntegerVariable` and `DoubleVariable` corrected to + return value rather than reference. + * add overload for `get_values` for `IntegerVariable` and `DoubleVariable` to + accept `std::vector` as argument rather than converting to bitset. + * add function `bitset_to_vector_internal` to `IterableBitset.h`. + * split `testthat/test/test-variables.R` into `testthat/test/test-categoricalvariable.R`, + `testthat/test/test-integervariable.R`, and `testthat/test/test-doublevariable.R` + * remove unnecessary `#include` statements from header files. + * remove unnecessary comparisons for `size_t` types. + diff --git a/R/RcppExports.R b/R/RcppExports.R index 7af910b8..72c51dba 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -29,8 +29,8 @@ bitset_and <- function(a, b) { invisible(.Call(`_individual_bitset_and`, a, b)) } -bitset_not <- function(b) { - .Call(`_individual_bitset_not`, b) +bitset_not <- function(b, inplace) { + .Call(`_individual_bitset_not`, b, inplace) } bitset_or <- function(a, b) { @@ -181,6 +181,10 @@ targeted_event_schedule_multi_delay <- function(event, target, delay) { invisible(.Call(`_individual_targeted_event_schedule_multi_delay`, event, target, delay)) } +targeted_event_schedule_multi_delay_vector <- function(event, target, delay) { + invisible(.Call(`_individual_targeted_event_schedule_multi_delay_vector`, event, target, delay)) +} + event_get_timestep <- function(event) { .Call(`_individual_event_get_timestep`, event) } diff --git a/R/bitset.R b/R/bitset.R index 10b68cf5..9c678f53 100644 --- a/R/bitset.R +++ b/R/bitset.R @@ -3,7 +3,7 @@ #' integers in some finite set (\code{max_size}), and can #' efficiently perform set operations (union, intersection, complement, symmetric #' difference, set difference). -#' WARNING: all operations (except \code{$not}) are in-place so please use \code{$copy} +#' WARNING: All operations are in-place so please use \code{$copy} #' if you would like to perform an operation without destroying your current bitset. #' @importFrom R6 R6Class #' @export @@ -62,8 +62,20 @@ Bitset <- R6Class( }, #' @description to "bitwise not" or complement a bitset - #' This method returns a new bitset rather than doing in-place modification. - not = function() Bitset$new(from = bitset_not(self$.bitset)), + #' @param inplace whether to overwrite the current bitset + not = function(inplace) { + if (missing(inplace)) { + warning(paste( + "DEPRECATED: Future versions of Bitset$not will be in place", + "to be consistent with other bitset operations.", + "To copy this bitset please use the copy method.", + "To suppress this warning, please set the `inplace` argument.", + sep = " " + )) + inplace <- FALSE + } + Bitset$new(from = bitset_not(self$.bitset, inplace)) + }, #' @description to "bitwise xor" or get the symmetric difference of two bitset #' (keep elements in either bitset but not in their intersection) @@ -84,7 +96,7 @@ Bitset <- R6Class( #' @description sample a bitset #' @param rate the success probability for keeping each element, can be #' a single value for all elements or a vector with of unique - #' probabilities for keeping each element + #' probabilities for keeping each element. sample = function(rate) { if (length(rate) == 1) { bitset_sample(self$.bitset, rate) @@ -98,7 +110,7 @@ Bitset <- R6Class( #' @description choose k random items in the bitset #' @param k the number of items in the bitset to keep. The selection of #' these k items from N total items in the bitset is random, and - #' k should be chosen such that 0 <= k <= N. + #' k should be chosen such that \eqn{0 \le k \le N}. choose = function(k) { stopifnot(is.finite(k)) stopifnot(k <= bitset_size(self$.bitset)) diff --git a/R/categorical_variable.R b/R/categorical_variable.R index d1af4935..198ff7ab 100644 --- a/R/categorical_variable.R +++ b/R/categorical_variable.R @@ -50,7 +50,11 @@ CategoricalVariable <- R6Class( if (inherits(index, "Bitset")) { categorical_variable_queue_update(self$.variable, value, index$.bitset) } else { - categorical_variable_queue_update_vector(self$.variable, value, as.integer(index)) + if (length(index) > 0) { + stopifnot(all(is.finite(index))) + stopifnot(all(index > 0)) + categorical_variable_queue_update_vector(self$.variable, value, index) + } } }, diff --git a/R/double_variable.R b/R/double_variable.R index d9a7646c..e873f9b3 100644 --- a/R/double_variable.R +++ b/R/double_variable.R @@ -21,12 +21,15 @@ DoubleVariable <- R6Class( get_values = function(index = NULL) { if (is.null(index)) { return(double_variable_get_values(self$.variable)) + } else { + if (inherits(index, 'Bitset')) { + return(double_variable_get_values_at_index(self$.variable, index$.bitset)) + } else { + stopifnot(all(is.finite(index))) + stopifnot(all(index > 0)) + return(double_variable_get_values_at_index_vector(self$.variable, index)) + } } - if (is.numeric(index)) { - stopifnot(all(index > 0)) - return(double_variable_get_values_at_index_vector(self$.variable, index)) - } - double_variable_get_values_at_index(self$.variable, index$.bitset) }, #' @description return a \code{\link[individual]{Bitset}} giving individuals @@ -35,7 +38,7 @@ DoubleVariable <- R6Class( #' @param b upper bound get_index_of = function(a, b) { stopifnot(a < b) - return(Bitset$new(from = double_variable_get_index_of_range(self$.variable, a, b))) + return(Bitset$new(from = double_variable_get_index_of_range(self$.variable, a, b))) }, #' @description return the number of individuals whose value lies in an interval @@ -44,7 +47,7 @@ DoubleVariable <- R6Class( #' @param b upper bound get_size_of = function(a, b) { stopifnot(a < b) - double_variable_get_size_of_range(self$.variable, a, b) + return(double_variable_get_size_of_range(self$.variable, a, b)) }, #' @description Queue an update for a variable. There are 4 types of variable update: @@ -92,6 +95,7 @@ DoubleVariable <- R6Class( } } else { if (length(index) != 0) { + stopifnot(all(is.finite(index))) stopifnot(all(index > 0)) double_variable_queue_update( self$.variable, diff --git a/R/integer_variable.R b/R/integer_variable.R index 7c04dbb5..a55494f9 100644 --- a/R/integer_variable.R +++ b/R/integer_variable.R @@ -25,12 +25,16 @@ IntegerVariable <- R6Class( get_values = function(index = NULL) { if (is.null(index)) { return(integer_variable_get_values(self$.variable)) + } else{ + if (inherits(index, 'Bitset')){ + return(integer_variable_get_values_at_index(self$.variable, index$.bitset)) + } else { + stopifnot(all(index > 0)) + stopifnot(all(is.finite(index))) + return(integer_variable_get_values_at_index_vector(self$.variable, index)) + } } - if (is.numeric(index)) { - stopifnot(all(index > 0)) - return(integer_variable_get_values_at_index_vector(self$.variable, index)) - } - integer_variable_get_values_at_index(self$.variable, index$.bitset) + }, @@ -132,6 +136,7 @@ IntegerVariable <- R6Class( } } else { if (length(index) > 0) { + stopifnot(all(is.finite(index))) stopifnot(all(index > 0)) integer_variable_queue_update( self$.variable, diff --git a/R/targeted_event.R b/R/targeted_event.R index 77dec9a1..ab1321ea 100644 --- a/R/targeted_event.R +++ b/R/targeted_event.R @@ -17,24 +17,36 @@ TargetedEvent <- R6Class( #' @param target the individuals to pass to the listener, this may be #' either a vector of integers or a \code{\link[individual]{Bitset}}. #' @param delay the number of time steps to wait before triggering the event, - #' can be a scalar or an vector of values for events that should be triggered - #' multiple times, fore each targeted individual. + #' can be a scalar in which case all targeted individuals are scheduled for + #' for the same delay or an vector of values giving the delay for that + #' individual. schedule = function(target, delay) { - if (length(delay) == 1) { - if (is.numeric(target)) { - targeted_event_schedule_vector(self$.event, target, delay) + # vector delay + if (length(delay) > 1) { + if (inherits(target, 'Bitset')) { + if (target$size() > 0){ + targeted_event_schedule_multi_delay(self$.event, target$.bitset, delay) + } } else { - targeted_event_schedule(self$.event, target$.bitset, delay) + if (length(target) > 0) { + stopifnot(all(is.finite(target))) + stopifnot(all(target > 0)) + targeted_event_schedule_multi_delay_vector(self$.event, target, delay) + } } + # single delay } else { if (inherits(target, 'Bitset')) { - target <- target$to_vector() - } - - if (length(target) != length(delay)) { - stop('target and delay must be the same size') + if (target$size() > 0){ + targeted_event_schedule(self$.event, target$.bitset, delay) + } + } else { + if (length(target) > 0){ + stopifnot(all(is.finite(target))) + stopifnot(all(target > 0)) + targeted_event_schedule_vector(self$.event, target, delay) + } } - targeted_event_schedule_multi_delay(self$.event, target, delay) } }, diff --git a/README.md b/README.md index 62fd2b4d..953c9093 100644 --- a/README.md +++ b/README.md @@ -24,6 +24,13 @@ library('remotes') install_github('mrc-ide/individual') ``` +Alternatively you can install individual directly from CRAN, but be aware that +the CRAN version may not be the most recent version of the package: + +```R +install.packages("individual") +``` + For development it is most convenient to run the code from source. You can install the dependencies in RStudio by opening the project and selecting "Build" > "Install and Restart" @@ -54,6 +61,33 @@ which describes in detail how to use the data structures in "individual" to build more complicated models. If you are running into performance issues, learn more about how to speed up your model in `vignette("Performance")`. +## Statement of need + +Individual based models are important tools for infectious disease epidemiology, +but practical use requires an implementation that is both comprehensible so that +code may be maintained and adapted, and fast. "individual" is an R package which +provides users a set of primitive classes using the [R6](https://github.com/r-lib/R6) +class system that define elements common to many tasks in infectious disease +modeling. Using R6 classes helps ensure that methods invoked on objects are +appropriate for that object type, aiding in testing and maintenance of models +programmed using "individual". Computation is carried out in C++ using +[Rcpp](https://github.com/RcppCore/Rcpp) to link to R, helping achieve good +performance for even complex models. + +"individual" provides a unique method to specify individual based models compared +to other agent/individual based modeling libraries, where users specify a type +for agents, which are subsequently stored in an array or other data structure. +In "individual", users instead instantiate a object for each variable which +describes some aspect of state, using the appropriate R6 class. Finding subsets +of individuals with particular combinations of state variables for further +computation can be efficiently accomplished with set operations, using a custom +bitset class implemented in C++. Additionally, the software makes no assumptions +on the types of models that may be simulated (*e.g.* mass action, network), +and updates are performed on a discrete time step. + +We hope our software is useful to infectious disease modellers, ecologists, and +others who are interested in individual-based modeling in R. + ## Contributing Thank you! Please refer to the vignette on `vignette("Contributing")` for info on how to diff --git a/_pkgdown.yml b/_pkgdown.yml index 6ef5f5a6..41d25a72 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1 +1,26 @@ destination: docs +reference: +- title: "Variables" + desc: > + Variables are how individual represents state, and operations to find subsets + of individuals based on values of their variable(s) return bitsets. +- contents: + - CategoricalVariable + - IntegerVariable + - DoubleVariable + - Bitset + - filter_bitset +- title: "Events & Rendering" + desc: "Classes for events and rendering output." +- contents: + - Event + - TargetedEvent + - Render +- title: "Prefabs" + desc: "Optimized processes and event listeners." +- contents: + - ends_with("process") + - ends_with("listener") +- title: "Simulation" +- contents: + - simulation_loop diff --git a/inst/include/CategoricalVariable.h b/inst/include/CategoricalVariable.h index ab7b739f..9c9d0047 100644 --- a/inst/include/CategoricalVariable.h +++ b/inst/include/CategoricalVariable.h @@ -130,7 +130,7 @@ inline void CategoricalVariable::queue_update( inline void CategoricalVariable::update() { while(updates.size() > 0) { auto& next = updates.front(); - auto inverse_update = ~next.second; + auto inverse_update = !next.second; for (auto& entry : indices) { if (entry.first == next.first) { // destination state diff --git a/inst/include/DoubleVariable.h b/inst/include/DoubleVariable.h index 85932bef..1b91ec24 100644 --- a/inst/include/DoubleVariable.h +++ b/inst/include/DoubleVariable.h @@ -74,7 +74,12 @@ inline std::vector DoubleVariable::get_values(const std::vector& auto result = std::vector(index.size()); for (auto i = 0u; i < index.size(); ++i) { - result[i] = values.at(index[i]); + if (index[i] >= size) { + std::stringstream message; + message << "index for DoubleVariable out of range, supplied index: " << index[i] << ", size of variable: " << size; + Rcpp::stop(message.str()); + } + result[i] = values[index[i]]; } return result; } diff --git a/inst/include/Event.h b/inst/include/Event.h index ebbce9e8..3528652f 100644 --- a/inst/include/Event.h +++ b/inst/include/Event.h @@ -1,12 +1,12 @@ /* - * Scheduler.h -> Event.h + * Event.h * * Created on: 19 May 2020 * Author: gc1610 */ -#ifndef INST_INCLUDE_SCHEDULER_H_ -#define INST_INCLUDE_SCHEDULER_H_ +#ifndef INST_INCLUDE_EVENT_H_ +#define INST_INCLUDE_EVENT_H_ #include "common_types.h" #include @@ -17,149 +17,269 @@ using listener_t = std::function; using targeted_listener_t = std::function; + +//' @title round a double, will error if input is negative or not finite +inline size_t round_double(double x) { + if (x < 0.0 || !std::isfinite(x)) { + Rcpp::stop("delay must be >= 0"); + } else { + return static_cast(std::round(x)); + } +} + +//' @title round a vector of doubles inline std::vector round_delay(const std::vector& delay) { auto rounded = std::vector(delay.size()); for (auto i = 0u; i < delay.size(); ++i) { - if (delay[i] < 0) { - Rcpp::stop("delay must be >= 0"); - } - rounded[i] = static_cast(round(delay[i])); + rounded[i] = round_double(delay[i]); } return rounded; } +//' @title abstract base class for events struct EventBase { size_t t = 1; - virtual void tick() { - ++t; - } - + virtual void tick(); + virtual bool should_trigger() = 0; virtual ~EventBase() = default; }; +//' @title increase time step by one +inline void EventBase::tick() { + ++t; +} + + +//' @title a general event in the simulation +//' @description This class provides functionality for general events which are +//' applied to all individuals in the simulation. It inherits from EventBase. +//' It contains the following data members: +//' * t: current simulation time step +//' * simple_schedule: a set of times the event will fire struct Event : public EventBase { std::set simple_schedule; + + virtual ~Event() = default; - virtual void process(Rcpp::XPtr listener) { - (*listener)(t); - } + virtual void process(Rcpp::XPtr listener); + virtual bool should_trigger() override; + virtual void tick() override; - virtual bool should_trigger() override { - return *simple_schedule.begin() == t; - } + virtual void schedule(std::vector delays); + virtual void clear_schedule(); + +}; - virtual void tick() override { - simple_schedule.erase(t); - EventBase::tick(); - } +//' @title process an event by calling a listener +inline void Event::process(Rcpp::XPtr listener) { + (*listener)(t); +} - virtual void schedule(std::vector delays) { - for (auto delay : round_delay(delays)) { - simple_schedule.insert(t + delay); - } - } +//' @title should first event fire on this timestep? +inline bool Event::should_trigger() { + return *simple_schedule.begin() == t; +} + +//' @title delete current time step from simple_schedule and increase time step +inline void Event::tick() { + simple_schedule.erase(t); + EventBase::tick(); +} - virtual void clear_schedule() { - simple_schedule.clear(); +//' @title schedule a vector of events +inline void Event::schedule(std::vector delays) { + for (auto delay : round_delay(delays)) { + simple_schedule.insert(t + delay); } +} - virtual ~Event() {}; -}; +//' @title clear all scheduled events +inline void Event::clear_schedule() { + simple_schedule.clear(); +} + +//' @title a targeted event in the simulation +//' @description This class provides functionality for targeted events which are +//' applied to a subset of individuals in the simulation. It inherits from EventBase. +//' It contains the following data members: +//' * t: current simulation time step +//' * targeted_schedule: a map of times and bitsets of scheduled individuals +//' * size: size of population struct TargetedEvent : public EventBase { std::map targeted_schedule; - size_t size = 0; - TargetedEvent(size_t size) : size(size) {}; + TargetedEvent(size_t size); + virtual ~TargetedEvent() = default; - virtual bool should_trigger() override { - if (targeted_schedule.begin() == targeted_schedule.end()) { - return false; - } - return targeted_schedule.begin()->first == t; - } + virtual bool should_trigger() override; + virtual void process(Rcpp::XPtr listener); - virtual void process(Rcpp::XPtr listener) { - (*listener)(t, current_target()); - } + virtual individual_index_t& current_target(); + virtual void tick() override; - virtual individual_index_t& current_target() { - return targeted_schedule.begin()->second; - } + virtual void schedule( + const individual_index_t& target_bitset, + const std::vector& delay + ); + virtual void schedule( + const std::vector& target_vector, + const std::vector& delay + ); + virtual void schedule( + const individual_index_t& target, + double delay + ); + virtual void schedule( + const individual_index_t& target, + size_t delay + ); + + virtual void clear_schedule(const individual_index_t& target); + virtual individual_index_t get_scheduled() const; - virtual void tick() override { - targeted_schedule.erase(t); - EventBase::tick(); +}; + +inline TargetedEvent::TargetedEvent(size_t size) : size(size) {}; + +//' @title should first event fire on this timestep? +inline bool TargetedEvent::should_trigger() { + if (targeted_schedule.begin() == targeted_schedule.end()) { + return false; } + return targeted_schedule.begin()->first == t; +} - //Schedule each individual in `target_vector` to fire an event - //at a corresponding `delay` timestep in the future. - //Delays may be continuous but our timeline is discrete. - //So delays are rounded to the nearest timestep - virtual void schedule( - const std::vector& target_vector, - const std::vector& delay) { +//' @title process an event by calling a listener +inline void TargetedEvent::process(Rcpp::XPtr listener) { + (*listener)(t, current_target()); +} - //round the delays to find a discrete timestep to trigger each event - auto rounded = round_delay(delay); +//' @title get bitset of individuals scheduled for the next event +inline individual_index_t& TargetedEvent::current_target() { + return targeted_schedule.begin()->second; +} - //get unique timesteps - auto delay_values = std::unordered_set( - rounded.begin(), - rounded.end() - ); +//' @title delete current time step from simple_schedule and increase time step +inline void TargetedEvent::tick() { + targeted_schedule.erase(t); + EventBase::tick(); +} - for (auto v : delay_values) { - auto target = individual_index_t(size); - for (auto i = 0u; i < rounded.size(); ++i) { - if (rounded[i] == v) { - target.insert(target_vector[i]); - } +//' @title schedule events +//' @description Schedule each individual in `target_bitset` to fire an event +//' at a corresponding `delay` timestep in the future. +//' Delays may be continuous but our timeline is discrete, +//' so delays are rounded to the nearest timestep +inline void TargetedEvent::schedule( + const individual_index_t& target_bitset, + const std::vector& delay +) { + + //round the delays to find a discrete timestep to trigger each event + auto rounded = round_delay(delay); + + //get unique timesteps + auto delay_values = std::unordered_set( + rounded.begin(), + rounded.end() + ); + + // iterate through unique delay vals; + // for each delay go through target_bitset and delay and add to target + // for that delay if the delay matches the unique value + for (auto v : delay_values) { + auto target = individual_index_t(size); + auto bitset_it = target_bitset.cbegin(); + for (auto i = 0u; i < rounded.size(); ++i) { + if (rounded[i] == v) { + target.insert(*bitset_it); } - schedule(target, v); + ++bitset_it; } + schedule(target, v); } +} - virtual void schedule( - const individual_index_t& target, - double delay) { - schedule(target, static_cast(round(delay))); +//' @title schedule events +//' @description Schedule each individual in `target_vector` to fire an event +//' at a corresponding `delay` timestep in the future. +//' Delays may be continuous but our timeline is discrete, +//' so delays are rounded to the nearest timestep +inline void TargetedEvent::schedule( + const std::vector& target_vector, + const std::vector& delay +) { + + //round the delays to find a discrete timestep to trigger each event + auto rounded = round_delay(delay); + + //get unique timesteps + auto delay_values = std::unordered_set( + rounded.begin(), + rounded.end() + ); + + for (auto v : delay_values) { + auto target = individual_index_t(size); + for (auto i = 0u; i < rounded.size(); ++i) { + if (rounded[i] == v) { + target.insert_safe(target_vector[i]); + } + } + schedule(target, v); } +} - virtual void schedule( - const individual_index_t& target, - size_t delay) { +//' @title schedule events +//' @description Schedule every individual in bitset `target` to fire an event +//' at `delay` timesteps in the future. +inline void TargetedEvent::schedule( + const individual_index_t& target, + double delay +) { + schedule(target, round_double(delay)); +} - auto target_timestep = t + delay; - if (targeted_schedule.find(target_timestep) == targeted_schedule.end()) { - targeted_schedule.insert( - {target_timestep, individual_index_t(size)} - ); - } - targeted_schedule.at(target_timestep) |= target; +//' @title schedule events +//' @description Schedule every individual in bitset `target` to fire an event +//' at `delay` timesteps in the future. +inline void TargetedEvent::schedule( + const individual_index_t& target, + size_t delay +) { + + auto target_timestep = t + delay; + if (targeted_schedule.find(target_timestep) == targeted_schedule.end()) { + targeted_schedule.insert( + {target_timestep, individual_index_t(size)} + ); } + targeted_schedule.at(target_timestep) |= target; +} - virtual void clear_schedule(const individual_index_t& target) { - auto not_target = ~target; - for (auto& entry : targeted_schedule) { - entry.second &= not_target; - } +//' @title clear scheduled events for `target` individuals +inline void TargetedEvent::clear_schedule(const individual_index_t& target) { + auto not_target = !target; + for (auto& entry : targeted_schedule) { + entry.second &= not_target; } +} - virtual individual_index_t get_scheduled() const { - auto scheduled = individual_index_t(size); - for (auto& entry : targeted_schedule) { - scheduled |= entry.second; - } - return scheduled; +//' @title get all individuals scheduled for events +inline individual_index_t TargetedEvent::get_scheduled() const { + auto scheduled = individual_index_t(size); + for (auto& entry : targeted_schedule) { + scheduled |= entry.second; } + return scheduled; +} + - virtual ~TargetedEvent() {}; -}; -#endif /* INST_INCLUDE_SCHEDULER_H_ */ +#endif /* INST_INCLUDE_EVENT_H_ */ diff --git a/inst/include/IntegerVariable.h b/inst/include/IntegerVariable.h index 8b8fd5ad..56c9c3bd 100644 --- a/inst/include/IntegerVariable.h +++ b/inst/include/IntegerVariable.h @@ -79,7 +79,12 @@ inline std::vector IntegerVariable::get_values(const std::vector& i auto result = std::vector(index.size()); for (auto i = 0u; i < index.size(); ++i) { - result[i] = values.at(index[i]); + if (index[i] >= size) { + std::stringstream message; + message << "index for IntegerVariable out of range, supplied index: " << index[i] << ", size of variable: " << size; + Rcpp::stop(message.str()); + } + result[i] = values[index[i]]; } return result; } diff --git a/inst/include/IterableBitset.h b/inst/include/IterableBitset.h index ffdef289..9eae22a3 100644 --- a/inst/include/IterableBitset.h +++ b/inst/include/IterableBitset.h @@ -73,10 +73,11 @@ class IterableBitset { IterableBitset operator&(const IterableBitset&) const; IterableBitset operator|(const IterableBitset&) const; IterableBitset operator^(const IterableBitset&) const; - IterableBitset operator~() const; + IterableBitset operator!() const; IterableBitset& operator&=(const IterableBitset&); IterableBitset& operator|=(const IterableBitset&); IterableBitset& operator^=(const IterableBitset&); + IterableBitset& inverse(); iterator begin(); const_iterator begin() const; const_iterator cbegin() const; @@ -232,15 +233,21 @@ inline IterableBitset IterableBitset::operator ^(const IterableBitset& } template -inline IterableBitset IterableBitset::operator ~() const { - auto result = IterableBitset(*this); - for (auto i = 0u; i < result.bitmap.size(); ++i) { - result.bitmap[i] = ~result.bitmap[i]; +inline IterableBitset& IterableBitset::inverse() { + for (auto i = 0u; i < bitmap.size(); ++i) { + bitmap[i] = ~bitmap[i]; } //mask out the values after max_n - A residual = (static_cast(1) << (result.max_n % result.num_bits)) - 1; - result.bitmap[result.bitmap.size() - 1] &= residual; - result.n = result.max_n - result.n; + A residual = (static_cast(1) << (max_n % num_bits)) - 1; + bitmap[bitmap.size() - 1] &= residual; + n = max_n - n; + return *this; +} + +template +inline IterableBitset IterableBitset::operator !() const { + auto result = IterableBitset(*this); + result.inverse(); return result; } @@ -361,6 +368,11 @@ inline void IterableBitset::insert(InputIterator begin, InputIterator end) { } } +//' @title safe insert many +//' @description insert several elements into the bitset. Each insert calls +//' `insert_safe` which includes bounds checking, and this method should be used +//' to insert data into bitsets from vector and other non bitset objects which +//' may have bad input. template template inline void IterableBitset::insert_safe(InputIterator begin, InputIterator end) { @@ -381,6 +393,10 @@ inline void IterableBitset::insert(size_t v) { } } +//' @title safe insert +//' @description check if insert is in range and then insert one element into +//' the bitset. This method should be used to insert from data in vectors and +//' other non bitset objects which may have bad input. template inline void IterableBitset::insert_safe(size_t v) { if (v >= max_n) { diff --git a/man/.DS_Store b/man/.DS_Store deleted file mode 100644 index 7223544b..00000000 Binary files a/man/.DS_Store and /dev/null differ diff --git a/man/Bitset.Rd b/man/Bitset.Rd index fe527bc1..cddb4212 100644 --- a/man/Bitset.Rd +++ b/man/Bitset.Rd @@ -8,7 +8,7 @@ This is a data strucutre that compactly stores the presence of integers in some finite set (\code{max_size}), and can efficiently perform set operations (union, intersection, complement, symmetric difference, set difference). -WARNING: all operations (except \code{$not}) are in-place so please use \code{$copy} +WARNING: All operations are in-place so please use \code{$copy} if you would like to perform an operation without destroying your current bitset. } \section{Public fields}{ @@ -142,11 +142,17 @@ to "bitwise and" or intersect two bitsets \if{latex}{\out{\hypertarget{method-not}{}}} \subsection{Method \code{not()}}{ to "bitwise not" or complement a bitset -This method returns a new bitset rather than doing in-place modification. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Bitset$not()}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{Bitset$not(inplace)}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{inplace}}{whether to overwrite the current bitset} +} +\if{html}{\out{
}} +} } \if{html}{\out{
}} \if{html}{\out{
}} @@ -198,7 +204,7 @@ sample a bitset \describe{ \item{\code{rate}}{the success probability for keeping each element, can be a single value for all elements or a vector with of unique -probabilities for keeping each element} +probabilities for keeping each element.} } \if{html}{\out{}} } @@ -217,7 +223,7 @@ choose k random items in the bitset \describe{ \item{\code{k}}{the number of items in the bitset to keep. The selection of these k items from N total items in the bitset is random, and -k should be chosen such that 0 <= k <= N.} +k should be chosen such that \eqn{0 \le k \le N}.} } \if{html}{\out{}} } diff --git a/man/TargetedEvent.Rd b/man/TargetedEvent.Rd index 1f09d0d7..116a885c 100644 --- a/man/TargetedEvent.Rd +++ b/man/TargetedEvent.Rd @@ -64,8 +64,9 @@ Schedule this event to occur in the future either a vector of integers or a \code{\link[individual]{Bitset}}.} \item{\code{delay}}{the number of time steps to wait before triggering the event, -can be a scalar or an vector of values for events that should be triggered -multiple times, fore each targeted individual.} +can be a scalar in which case all targeted individuals are scheduled for +for the same delay or an vector of values giving the delay for that +individual.} } \if{html}{\out{}} } diff --git a/man/figures/.DS_Store b/man/figures/.DS_Store deleted file mode 100644 index 5008ddfc..00000000 Binary files a/man/figures/.DS_Store and /dev/null differ diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index c20e19d8..a85ffa02 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -92,13 +92,14 @@ BEGIN_RCPP END_RCPP } // bitset_not -Rcpp::XPtr bitset_not(const Rcpp::XPtr b); -RcppExport SEXP _individual_bitset_not(SEXP bSEXP) { +Rcpp::XPtr bitset_not(const Rcpp::XPtr b, const bool inplace); +RcppExport SEXP _individual_bitset_not(SEXP bSEXP, SEXP inplaceSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const Rcpp::XPtr >::type b(bSEXP); - rcpp_result_gen = Rcpp::wrap(bitset_not(b)); + Rcpp::traits::input_parameter< const bool >::type inplace(inplaceSEXP); + rcpp_result_gen = Rcpp::wrap(bitset_not(b, inplace)); return rcpp_result_gen; END_RCPP } @@ -543,17 +544,29 @@ BEGIN_RCPP END_RCPP } // targeted_event_schedule_multi_delay -void targeted_event_schedule_multi_delay(const Rcpp::XPtr event, std::vector target, const std::vector delay); +void targeted_event_schedule_multi_delay(const Rcpp::XPtr event, const Rcpp::XPtr target, const std::vector delay); RcppExport SEXP _individual_targeted_event_schedule_multi_delay(SEXP eventSEXP, SEXP targetSEXP, SEXP delaySEXP) { BEGIN_RCPP Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const Rcpp::XPtr >::type event(eventSEXP); - Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); + Rcpp::traits::input_parameter< const Rcpp::XPtr >::type target(targetSEXP); Rcpp::traits::input_parameter< const std::vector >::type delay(delaySEXP); targeted_event_schedule_multi_delay(event, target, delay); return R_NilValue; END_RCPP } +// targeted_event_schedule_multi_delay_vector +void targeted_event_schedule_multi_delay_vector(const Rcpp::XPtr event, std::vector target, const std::vector delay); +RcppExport SEXP _individual_targeted_event_schedule_multi_delay_vector(SEXP eventSEXP, SEXP targetSEXP, SEXP delaySEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::XPtr >::type event(eventSEXP); + Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); + Rcpp::traits::input_parameter< const std::vector >::type delay(delaySEXP); + targeted_event_schedule_multi_delay_vector(event, target, delay); + return R_NilValue; +END_RCPP +} // event_get_timestep size_t event_get_timestep(const Rcpp::XPtr event); RcppExport SEXP _individual_event_get_timestep(SEXP eventSEXP) { @@ -876,7 +889,7 @@ static const R_CallMethodDef CallEntries[] = { {"_individual_bitset_size", (DL_FUNC) &_individual_bitset_size, 1}, {"_individual_bitset_max_size", (DL_FUNC) &_individual_bitset_max_size, 1}, {"_individual_bitset_and", (DL_FUNC) &_individual_bitset_and, 2}, - {"_individual_bitset_not", (DL_FUNC) &_individual_bitset_not, 1}, + {"_individual_bitset_not", (DL_FUNC) &_individual_bitset_not, 2}, {"_individual_bitset_or", (DL_FUNC) &_individual_bitset_or, 2}, {"_individual_bitset_xor", (DL_FUNC) &_individual_bitset_xor, 2}, {"_individual_bitset_set_difference", (DL_FUNC) &_individual_bitset_set_difference, 2}, @@ -915,6 +928,7 @@ static const R_CallMethodDef CallEntries[] = { {"_individual_targeted_event_schedule", (DL_FUNC) &_individual_targeted_event_schedule, 3}, {"_individual_targeted_event_schedule_vector", (DL_FUNC) &_individual_targeted_event_schedule_vector, 3}, {"_individual_targeted_event_schedule_multi_delay", (DL_FUNC) &_individual_targeted_event_schedule_multi_delay, 3}, + {"_individual_targeted_event_schedule_multi_delay_vector", (DL_FUNC) &_individual_targeted_event_schedule_multi_delay_vector, 3}, {"_individual_event_get_timestep", (DL_FUNC) &_individual_event_get_timestep, 1}, {"_individual_event_should_trigger", (DL_FUNC) &_individual_event_should_trigger, 1}, {"_individual_targeted_event_get_target", (DL_FUNC) &_individual_targeted_event_get_target, 1}, diff --git a/src/bitset.cpp b/src/bitset.cpp index 490d4ef2..b1787aaf 100644 --- a/src/bitset.cpp +++ b/src/bitset.cpp @@ -62,9 +62,17 @@ void bitset_and( //[[Rcpp::export]] Rcpp::XPtr bitset_not( - const Rcpp::XPtr b + const Rcpp::XPtr b, + const bool inplace ) { - return Rcpp::XPtr(new individual_index_t(~(*b)), true); + if (inplace) { + b->inverse(); + return b; + } + return Rcpp::XPtr( + new individual_index_t(!(*b)), + true + ); } //[[Rcpp::export]] @@ -88,7 +96,7 @@ void bitset_set_difference( const Rcpp::XPtr a, const Rcpp::XPtr b ) { - (*a) &= ~(*b); + (*a) &= !(*b); } //[[Rcpp::export]] diff --git a/src/categorical_variable.cpp b/src/categorical_variable.cpp index 4dbb0270..ff441647 100644 --- a/src/categorical_variable.cpp +++ b/src/categorical_variable.cpp @@ -68,7 +68,7 @@ void categorical_variable_queue_update_vector( ) { decrement(index); auto bitmap = individual_index_t(variable->size); - bitmap.insert(index.begin(), index.end()); + bitmap.insert_safe(index.begin(), index.end()); variable->queue_update(value, bitmap); } diff --git a/src/event.cpp b/src/event.cpp index 796b5c73..21ca0a0a 100644 --- a/src/event.cpp +++ b/src/event.cpp @@ -40,7 +40,7 @@ void targeted_event_clear_schedule_vector( ) { decrement(target); auto bitmap = individual_index_t(event->size); - bitmap.insert(target.cbegin(), target.cend()); + bitmap.insert_safe(target.cbegin(), target.cend()); event->clear_schedule(bitmap); } @@ -67,6 +67,9 @@ void targeted_event_schedule( const Rcpp::XPtr event, const Rcpp::XPtr target, double delay) { + if (target->max_size() != event->size) { + Rcpp::stop("incompatible size bitset used to schedule TargetedEvent"); + } event->schedule(*target, delay); } @@ -77,15 +80,33 @@ void targeted_event_schedule_vector( double delay) { decrement(target); auto bitmap = individual_index_t(event->size); - bitmap.insert(target.begin(), target.end()); + bitmap.insert_safe(target.cbegin(), target.cend()); event->schedule(bitmap, delay); } //[[Rcpp::export]] void targeted_event_schedule_multi_delay( + const Rcpp::XPtr event, + const Rcpp::XPtr target, + const std::vector delay) { + if (target->max_size() != event->size) { + Rcpp::stop("incompatible size bitset used to schedule TargetedEvent"); + } + if (target->size() != delay.size()) { + Rcpp::stop("incompatible size bitset and delay vector used to schedule TargetedEvent"); + } + event->schedule(*target, delay); +} + + +//[[Rcpp::export]] +void targeted_event_schedule_multi_delay_vector( const Rcpp::XPtr event, std::vector target, const std::vector delay) { + if (target.size() != delay.size()) { + Rcpp::stop("incompatible size target and delay vector used to schedule TargetedEvent"); + } decrement(target); event->schedule(target, delay); } diff --git a/tests/testthat/helper-event.R b/tests/testthat/helper-targetedevent.R similarity index 100% rename from tests/testthat/helper-event.R rename to tests/testthat/helper-targetedevent.R diff --git a/tests/testthat/test-bitset.R b/tests/testthat/test-bitset.R index 1d82f27e..85489d7e 100644 --- a/tests/testthat/test-bitset.R +++ b/tests/testthat/test-bitset.R @@ -129,13 +129,13 @@ test_that("bitset xor works for disjoint sets", { test_that("bitset combinations work", { - a <- Bitset$new(10)$not() + a <- Bitset$new(10)$not(FALSE) b <- Bitset$new(10) expect_equal(a$or(b)$to_vector(), seq(10)) }) test_that("multi-word bitset combinations work", { - a <- Bitset$new(100)$not() + a <- Bitset$new(100)$not(FALSE) b <- Bitset$new(100) expect_equal(a$or(b)$to_vector(), seq(100)) }) @@ -143,8 +143,19 @@ test_that("multi-word bitset combinations work", { test_that("bitset inverse works", { a <- Bitset$new(10) a$insert(c(1, 5, 6)) - expect_equal(a$not()$to_vector(), c(2, 3, 4, 7, 8, 9, 10)) - expect_equal(a$not()$size(), 7) + expect_equal(a$not(FALSE)$to_vector(), c(2, 3, 4, 7, 8, 9, 10)) + expect_equal(a$not(TRUE)$size(), 7) +}) + +test_that("bitset not inplace switch works", { + a <- Bitset$new(10) + a$insert(c(1, 5, 6)) + b <- a + a$not(TRUE) + expect_equal(b$to_vector(), c(2, 3, 4, 7, 8, 9, 10)) + b <- b$not(FALSE) + expect_equal(a$to_vector(), c(2, 3, 4, 7, 8, 9, 10)) + expect_equal(b$to_vector(), c(1, 5, 6)) }) test_that("bitset sample works at rate = 0", { diff --git a/tests/testthat/test-categoricalvariable.R b/tests/testthat/test-categoricalvariable.R index f158122c..62c66ad4 100644 --- a/tests/testthat/test-categoricalvariable.R +++ b/tests/testthat/test-categoricalvariable.R @@ -71,4 +71,9 @@ test_that("Queuing invalid category errors", { expect_error(variable$queue_update("X", Bitset$new(1)$insert(1)), '*' ) +}) + +test_that("Queuing invalid indices errors", { + c <- CategoricalVariable$new(categories = c("A","B"),initial_values = rep(c("A","B"),each=10)) + expect_error(c$queue_update(value = "A",index = c(15,25,50))) }) \ No newline at end of file diff --git a/tests/testthat/test-events.R b/tests/testthat/test-events.R index bcae5d19..cb6ad3b2 100644 --- a/tests/testthat/test-events.R +++ b/tests/testthat/test-events.R @@ -15,39 +15,28 @@ test_that("first event is triggered at t=1", { event$.tick() }) -test_that("events can be scheduled for the future", { +test_that("first event is triggered at t=1", { event <- Event$new() listener <- mockery::mock() event$add_listener(listener) - event$schedule(c(2, 3)) - + event$schedule(c(0, 1)) + #time = 1 event$.process() - mockery::expect_called(listener, 0) + mockery::expect_args(listener, 1, t = 1) event$.tick() - + #time = 2 event$.process() - mockery::expect_called(listener, 0) - event$.tick() - - #time = 3 - event$.process() - mockery::expect_called(listener, 1) + mockery::expect_args(listener, 2, t = 2) event$.tick() - - #time = 4 - event$.process() - mockery::expect_called(listener, 2) - mockery::expect_args(listener, 1, t = 3) - mockery::expect_args(listener, 2, t = 4) }) -test_that("targeted events can be scheduled for the future", { - event <- TargetedEvent$new(10) +test_that("events can be scheduled for the future", { + event <- Event$new() listener <- mockery::mock() event$add_listener(listener) - event$schedule(c(2, 4), 2) + event$schedule(c(2, 3)) #time = 1 event$.process() @@ -66,156 +55,35 @@ test_that("targeted events can be scheduled for the future", { #time = 4 event$.process() - mockery::expect_called(listener, 1) - expect_targeted_listener(listener, 1, t = 3, target = c(2, 4)) + mockery::expect_called(listener, 2) + mockery::expect_args(listener, 1, t = 3) + mockery::expect_args(listener, 2, t = 4) }) -test_that("events can be scheduled for for a Real time", { - event <- TargetedEvent$new(10) +test_that("events can be scheduled for a real time", { + event <- Event$new() listener <- mockery::mock() event$add_listener(listener) - event$schedule(c(2, 4), 1.9) - + event$schedule(c(2.1, 3.1)) + #time = 1 event$.process() mockery::expect_called(listener, 0) event$.tick() - + #time = 2 event$.process() mockery::expect_called(listener, 0) event$.tick() - + #time = 3 event$.process() mockery::expect_called(listener, 1) event$.tick() - + #time = 4 event$.process() - mockery::expect_called(listener, 1) - expect_targeted_listener(listener, 1, t = 3, target = c(2, 4)) -}) - -test_that("you can schedule different times for a target population", { - event <- TargetedEvent$new(10) - listener <- mockery::mock() - event$add_listener(listener) - event$schedule(c(1, 2, 4, 8, 3), c(1, 3, 1, 2, 2)) - - #time = 1 - event$.process() - mockery::expect_called(listener, 0) - event$.tick() - - #time = 2 - event$.process() - mockery::expect_called(listener, 1) - expect_targeted_listener(listener, 1, t = 2, target = c(1, 4)) - event$.tick() - - #time = 3 - event$.process() mockery::expect_called(listener, 2) - expect_targeted_listener(listener, 2, t = 3, target = c(3, 8)) - event$.tick() - - #time = 4 - event$.process() - mockery::expect_called(listener, 3) - expect_targeted_listener(listener, 3, t = 4, target = 2) -}) - -test_that("when you can schedule different times invalid times cause an error", { - event <- TargetedEvent$new(10) - listener <- mockery::mock() - event$add_listener(listener) - expect_error( - event$schedule(c(1, 2, 4, 8, 3), c(1, 3, 1, 2)), - '*' - ) - expect_error( - event$schedule(c(1, 2, 4, 8, 3), c(1, 3, 1, 2, -1)), - '*' - ) -}) - -test_that("you can see which individuals are scheduled for an event", { - event <- TargetedEvent$new(10) - listener <- mockery::mock() - event$add_listener(listener) - - expect_length(event$get_scheduled()$to_vector(), 0) - - #time = 1 - event$schedule(c(2, 4), 2) - event$.process() - expect_setequal(event$get_scheduled()$to_vector(), c(2, 4)) - event$.tick() - - #time = 2 - event$schedule(c(3, 4), 1) - event$.process() - expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) - event$.tick() - - #time = 3 - event$.process() - expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) - event$.tick() - - #time = 4 - event$.process() - expect_length(event$get_scheduled()$to_vector(), 0) -}) - -test_that("multiple events can be scheduled", { - event1 <- TargetedEvent$new(10) - event2 <- TargetedEvent$new(10) - listener1 <- mockery::mock() - listener2 <- mockery::mock() - event1$add_listener(listener1) - event2$add_listener(listener2) - - expect_length(event1$get_scheduled()$to_vector(), 0) - expect_length(event2$get_scheduled()$to_vector(), 0) - - #time = 1 - event1$schedule(c(2, 4), 1) - event2$schedule(c(1, 3), 1) - event1$.process() - event2$.process() - expect_setequal(event1$get_scheduled()$to_vector(), c(2, 4)) - expect_setequal(event2$get_scheduled()$to_vector(), c(1, 3)) - - event1$.tick() - event2$.tick() - event1$.process() - event2$.process() - - mockery::expect_called(listener1, 1) - mockery::expect_called(listener2, 1) - expect_targeted_listener(listener1, 1, t = 2, target = c(2, 4)) - expect_targeted_listener(listener2, 1, t = 2, target = c(1, 3)) -}) - -test_that("events can be cleared for an individual", { - event <- TargetedEvent$new(10) - listener <- mockery::mock() - event$add_listener(listener) - - expect_length(event$get_scheduled()$to_vector(), 0) - - #time = 1 - event$schedule(c(2, 3, 4), 1) - event$.process() - expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) - event$.tick() - - #time = 2 - event$clear_schedule(c(3, 4)) - expect_setequal(event$get_scheduled()$to_vector(), 2) - event$.process() - mockery::expect_called(listener, 1) - expect_targeted_listener(listener, 1, t = 2, target = 2) -}) + mockery::expect_args(listener, 1, t = 3) + mockery::expect_args(listener, 2, t = 4) +}) \ No newline at end of file diff --git a/tests/testthat/test-simulation-e2e.R b/tests/testthat/test-simulation-e2e.R index b0dc7637..64f6af36 100644 --- a/tests/testthat/test-simulation-e2e.R +++ b/tests/testthat/test-simulation-e2e.R @@ -66,7 +66,7 @@ test_that("deterministic state model w events works", { function(t) { from_state <- state$get_index_of(from) # remove the already scheduled individuals - from_state$and(event$get_scheduled()$not()) + from_state$and(event$get_scheduled()$not(TRUE)) target <- from_state$to_vector()[seq_len(min(rate,from_state$size()))] event$schedule(target, delay); } diff --git a/tests/testthat/test-targetedevent.R b/tests/testthat/test-targetedevent.R new file mode 100644 index 00000000..7cdeb44d --- /dev/null +++ b/tests/testthat/test-targetedevent.R @@ -0,0 +1,528 @@ +test_that("targeted events can be scheduled for the future (vector)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + event$schedule(c(2, 4), 2) + + #time = 1 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 2 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 3 + event$.process() + mockery::expect_called(listener, 1) + event$.tick() + + #time = 4 + event$.process() + mockery::expect_called(listener, 1) + expect_targeted_listener(listener, 1, t = 3, target = c(2, 4)) +}) + +test_that("targeted events can be scheduled for the future (bitset)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + event$schedule(Bitset$new(10)$insert(c(2,4)), 2) + + #time = 1 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 2 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 3 + event$.process() + mockery::expect_called(listener, 1) + event$.tick() + + #time = 4 + event$.process() + mockery::expect_called(listener, 1) + expect_targeted_listener(listener, 1, t = 3, target = c(2, 4)) +}) + +test_that("events can be scheduled for for a Real time (vector)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + event$schedule(c(2, 4), 1.9) + + #time = 1 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 2 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 3 + event$.process() + mockery::expect_called(listener, 1) + event$.tick() + + #time = 4 + event$.process() + mockery::expect_called(listener, 1) + expect_targeted_listener(listener, 1, t = 3, target = c(2, 4)) +}) + +test_that("events can be scheduled for for a Real time (bitset)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + event$schedule(Bitset$new(10)$insert(c(2,4)), 1.9) + + #time = 1 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 2 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 3 + event$.process() + mockery::expect_called(listener, 1) + event$.tick() + + #time = 4 + event$.process() + mockery::expect_called(listener, 1) + expect_targeted_listener(listener, 1, t = 3, target = c(2, 4)) +}) + +test_that("empty update targets do not call listener (vector)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + event$schedule(integer(0), 1) + + #time = 1 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 2 + event$.process() + mockery::expect_called(listener, 0) +}) + +test_that("empty update targets do not call listener (bitset)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + event$schedule(Bitset$new(10), 1) + + #time = 1 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 2 + event$.process() + mockery::expect_called(listener, 0) +}) + +test_that("you can schedule different times for a target population (vector)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + event$schedule(c(1, 2, 4, 8, 3), c(1, 3, 1, 2, 2)) + + #time = 1 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 2 + event$.process() + mockery::expect_called(listener, 1) + expect_targeted_listener(listener, 1, t = 2, target = c(1, 4)) + event$.tick() + + #time = 3 + event$.process() + mockery::expect_called(listener, 2) + expect_targeted_listener(listener, 2, t = 3, target = c(3, 8)) + event$.tick() + + #time = 4 + event$.process() + mockery::expect_called(listener, 3) + expect_targeted_listener(listener, 3, t = 4, target = 2) +}) + +test_that("you can schedule different times for a target population (bitset)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + event$schedule(Bitset$new(10)$insert(c(1, 2, 3, 4, 8)), c(1, 3, 1, 2, 2)) + + #time = 1 + event$.process() + mockery::expect_called(listener, 0) + event$.tick() + + #time = 2 + event$.process() + mockery::expect_called(listener, 1) + expect_targeted_listener(listener, 1, t = 2, target = c(1, 3)) + event$.tick() + + #time = 3 + event$.process() + mockery::expect_called(listener, 2) + expect_targeted_listener(listener, 2, t = 3, target = c(4, 8)) + event$.tick() + + #time = 4 + event$.process() + mockery::expect_called(listener, 3) + expect_targeted_listener(listener, 3, t = 4, target = 2) +}) + +test_that("when you can schedule different times invalid times cause an error", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + expect_error( + event$schedule(c(1, 2, 4, 8, 3), c(1, 3, 1, 2)), + '*' + ) + expect_error( + event$schedule(c(1, 2, 4, 8, 3), c(1, 3, 1, 2, -1)), + '*' + ) + expect_error( + event$schedule(Bitset$new(10)$insert(c(1, 2, 4, 8, 3)), c(1, 3, 1, 2)), + '*' + ) + expect_error( + event$schedule(Bitset$new(10)$insert(c(1, 2, 4, 8, 3)), c(1, 3, 1, 2, -1)), + '*' + ) +}) + +test_that("you can see which individuals are scheduled for an event (vector)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + + expect_length(event$get_scheduled()$to_vector(), 0) + + #time = 1 + event$schedule(c(2, 4), 2) + event$.process() + expect_setequal(event$get_scheduled()$to_vector(), c(2, 4)) + event$.tick() + + #time = 2 + event$schedule(c(3, 4), 1) + event$.process() + expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) + event$.tick() + + #time = 3 + event$.process() + expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) + event$.tick() + + #time = 4 + event$.process() + expect_length(event$get_scheduled()$to_vector(), 0) +}) + +test_that("you can see which individuals are scheduled for an event (bitset)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + + expect_length(event$get_scheduled()$to_vector(), 0) + + #time = 1 + event$schedule(Bitset$new(10)$insert(c(2, 4)), 2) + event$.process() + expect_setequal(event$get_scheduled()$to_vector(), c(2, 4)) + event$.tick() + + #time = 2 + event$schedule(Bitset$new(10)$insert(c(3, 4)), 1) + event$.process() + expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) + event$.tick() + + #time = 3 + event$.process() + expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) + event$.tick() + + #time = 4 + event$.process() + expect_length(event$get_scheduled()$to_vector(), 0) +}) + +test_that("multiple events can be scheduled (vector)", { + event1 <- TargetedEvent$new(10) + event2 <- TargetedEvent$new(10) + listener1 <- mockery::mock() + listener2 <- mockery::mock() + event1$add_listener(listener1) + event2$add_listener(listener2) + + expect_length(event1$get_scheduled()$to_vector(), 0) + expect_length(event2$get_scheduled()$to_vector(), 0) + + #time = 1 + event1$schedule(c(2, 4), 1) + event2$schedule(c(1, 3), 1) + event1$.process() + event2$.process() + expect_setequal(event1$get_scheduled()$to_vector(), c(2, 4)) + expect_setequal(event2$get_scheduled()$to_vector(), c(1, 3)) + + event1$.tick() + event2$.tick() + event1$.process() + event2$.process() + + mockery::expect_called(listener1, 1) + mockery::expect_called(listener2, 1) + expect_targeted_listener(listener1, 1, t = 2, target = c(2, 4)) + expect_targeted_listener(listener2, 1, t = 2, target = c(1, 3)) +}) + +test_that("multiple events can be scheduled (bitset)", { + event1 <- TargetedEvent$new(10) + event2 <- TargetedEvent$new(10) + listener1 <- mockery::mock() + listener2 <- mockery::mock() + event1$add_listener(listener1) + event2$add_listener(listener2) + + expect_length(event1$get_scheduled()$to_vector(), 0) + expect_length(event2$get_scheduled()$to_vector(), 0) + + #time = 1 + event1$schedule(Bitset$new(10)$insert(c(2, 4)), 1) + event2$schedule(Bitset$new(10)$insert(c(1, 3)), 1) + event1$.process() + event2$.process() + expect_setequal(event1$get_scheduled()$to_vector(), c(2, 4)) + expect_setequal(event2$get_scheduled()$to_vector(), c(1, 3)) + + event1$.tick() + event2$.tick() + event1$.process() + event2$.process() + + mockery::expect_called(listener1, 1) + mockery::expect_called(listener2, 1) + expect_targeted_listener(listener1, 1, t = 2, target = c(2, 4)) + expect_targeted_listener(listener2, 1, t = 2, target = c(1, 3)) +}) + +test_that("events can be cleared for an individual (vector)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + + expect_length(event$get_scheduled()$to_vector(), 0) + + #time = 1 + event$schedule(c(2, 3, 4), 1) + event$.process() + expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) + event$.tick() + + #time = 2 + event$clear_schedule(c(3, 4)) + expect_setequal(event$get_scheduled()$to_vector(), 2) + event$.process() + mockery::expect_called(listener, 1) + expect_targeted_listener(listener, 1, t = 2, target = 2) +}) + +test_that("events can be cleared for an individual (bitset)", { + event <- TargetedEvent$new(10) + listener <- mockery::mock() + event$add_listener(listener) + + expect_length(event$get_scheduled()$to_vector(), 0) + + #time = 1 + event$schedule(Bitset$new(10)$insert(c(2, 3, 4)), 1) + event$.process() + expect_setequal(event$get_scheduled()$to_vector(), c(2, 3, 4)) + event$.tick() + + #time = 2 + event$clear_schedule(Bitset$new(10)$insert(c(3, 4))) + expect_setequal(event$get_scheduled()$to_vector(), 2) + event$.process() + mockery::expect_called(listener, 1) + expect_targeted_listener(listener, 1, t = 2, target = 2) +}) + +test_that("targeted events work for scalar delay, vector target", { + + # works as expected + event <- TargetedEvent$new(10) + target <- 1:5 + delay <- 5 + event$schedule(target = target,delay = delay) + expect_equal(event$get_scheduled()$to_vector(), target) + + # fails as expected (bad target) + event <- TargetedEvent$new(10) + target <- -5:5 + delay <- 5 + expect_error(event$schedule(target = target,delay = delay)) + + target <- 11:20 + expect_error(event$schedule(target = target,delay = delay)) + + target <- c(Inf,5) + expect_error(event$schedule(target = target,delay = delay)) + + target <- c(NaN,5) + expect_error(event$schedule(target = target,delay = delay)) + + # fails as expected (bad delay) + event <- TargetedEvent$new(10) + target <- 1:5 + delay <- -5 + expect_error(event$schedule(target = target,delay = delay)) + + delay <- NaN + expect_error(event$schedule(target = target,delay = delay)) + + delay <- numeric(0) + expect_error(event$schedule(target = target,delay = delay)) + +}) + +test_that("targeted events work for scalar delay, bitset target", { + + # works as expected + event <- TargetedEvent$new(10) + target <- Bitset$new(10)$insert(1:5) + delay <- 5 + event$schedule(target = target,delay = delay) + expect_equal(event$get_scheduled()$to_vector(), target$to_vector()) + + # fails as expected (bad target) + event <- TargetedEvent$new(10) + target <- Bitset$new(20)$insert(11:20) + delay <- 5 + expect_error(event$schedule(target = target,delay = delay)) + + # fails as expected (bad delay) + event <- TargetedEvent$new(10) + target <- Bitset$new(10)$insert(1:5) + delay <- NaN + expect_error(event$schedule(target = target,delay = delay)) + + delay <- numeric(0) + expect_error(event$schedule(target = target,delay = delay)) + +}) + +test_that("targeted events work for vector delay, vector target", { + + # works as expected + event <- TargetedEvent$new(10) + target <- 1:5 + delay <- 1:5 + event$schedule(target = target,delay = delay) + expect_equal(event$get_scheduled()$to_vector(), target) + + # fails as expected (bad target) + event <- TargetedEvent$new(10) + target <- -5:5 + delay <- 1:5 + expect_error(event$schedule(target = target,delay = delay)) + + # fails as expected (bad target) + event <- TargetedEvent$new(10) + target <- c(Inf,5) + delay <- c(1,1) + expect_error(event$schedule(target = target,delay = delay)) + + target <- c(NaN,5) + expect_error(event$schedule(target = target,delay = delay)) + + # fails as expected (bad delay) + event <- TargetedEvent$new(10) + target <- 1:5 + delay <- c(NaN,1,1,1,1) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- c(1,Inf,1,1,1) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- c(1,NA,1,1,1) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- numeric(0) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- c(-1,1,1,1,1) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- rep(0,10) + expect_error(event$schedule(target = target,delay = delay)) + +}) + +test_that("targeted events work for vector delay, bitset target", { + + # works as expected + event <- TargetedEvent$new(10) + target <- Bitset$new(10)$insert(1:5) + delay <- 1:5 + event$schedule(target = target,delay = delay) + expect_equal(event$get_scheduled()$to_vector(), target$to_vector()) + + # fails as expected (bad target) + event <- TargetedEvent$new(10) + target <- Bitset$new(20)$insert(1) + delay <- 1:5 + expect_error(event$schedule(target = target,delay = delay)) + + # fails as expected (bad delay) + event <- TargetedEvent$new(10) + target <- Bitset$new(10)$insert(1:5) + delay <- c(NaN,1,1,1,1) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- c(1,Inf,1,1,1) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- c(1,NA,1,1,1) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- numeric(0) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- c(-1,1,1,1,1) + expect_error(event$schedule(target = target,delay = delay)) + + delay <- rep(0,10) + expect_error(event$schedule(target = target,delay = delay)) + +}) diff --git a/vignettes/API.Rmd b/vignettes/API.Rmd index b32953dc..3bda9b9c 100644 --- a/vignettes/API.Rmd +++ b/vignettes/API.Rmd @@ -45,7 +45,7 @@ This vignette provides a description of the various primitive elements provided In "individual", variables are how one defines state, and represent any attribute of an individual. While many variables will be dynamically updated throughout a simulation, they don't have to be. Specifying a baseline characteristic for each individual that doesn't change over a simulation will still be specified using a variable object. -There are 3 types of variable objects: `individual::CategoricalVariable` for discrete variables taking values in a finite set, `individual::IntegerVariable` for discrete integer variables, and `individual::DoubleVariable` for continuous variables. +There are 3 types of variable objects: `individual::CategoricalVariable` can represent a set of mutually exclusive categories, `individual::IntegerVariable` for representing integers, and `individual::DoubleVariable` for continuous values (real numbers). ### Categorical Variable {#cat_var} diff --git a/vignettes/Contributing.Rmd b/vignettes/Contributing.Rmd index 9dae9df4..ed345ed1 100644 --- a/vignettes/Contributing.Rmd +++ b/vignettes/Contributing.Rmd @@ -30,7 +30,7 @@ For bug reports please include: ## Git -We use on this project. Which means we use `master`, `dev`, `feat/*`, `bug/*`, `hotfix/*` and `release/*` branches. Please refer to [this post](https://www.atlassian.com/git/tutorials/comparing-workflows/gitflow-workflow) for more information of each type of branch. NOTE: `bug/*` branches are `feat/*` branches which fix a bug. +We use Git on this project. Which means we use `master`, `dev`, `feat/*`, `bug/*`, `hotfix/*` and `release/*` branches. Please refer to [this post](https://www.atlassian.com/git/tutorials/comparing-workflows/gitflow-workflow) for more information of each type of branch. NOTE: `bug/*` branches are `feat/*` branches which fix a bug. Practically speaking, *all* new code contributions should be feature branches. You should branch off of the `dev` branch into one called `feat/[your feature name here]`. When we consider pull requests from forked repositories to the mrc-ide/individual repository, we will expect this convention. diff --git a/vignettes/Tutorial.Rmd b/vignettes/Tutorial.Rmd index 76308040..8b2c1d0a 100644 --- a/vignettes/Tutorial.Rmd +++ b/vignettes/Tutorial.Rmd @@ -93,7 +93,7 @@ We note at this point would be possible to queue the recovery event at the same recovery_process <- function(t){ I <- health$get_index_of("I") already_scheduled <- recovery_event$get_scheduled() - I$and(already_scheduled$not()) + I$and(already_scheduled$not(inplace = TRUE)) rec_times <- rgeom(n = I$size(),prob = pexp(q = gamma * dt)) + 1 recovery_event$schedule(target = I,delay = rec_times) }