Merge pull request #144 from mrc-ide/dev

Dev: update to 0.1.6

.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,45 +47,38 @@ 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
         if: failure()
         uses: actions/upload-artifact@main
         with:
           name: ${{ runner.os }}-r${{ matrix.config.r }}-results
-          path: check
+          path: check

.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

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",

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<size_t>` 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.
+

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)
 }

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))

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)
+        }
       }
     },
 

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,

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,

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)
       }
     },