Add a method to overwrite a bitset. (#200)

This copies the value from one bitset to another one.

R/RcppExports.R

@@ -41,6 +41,10 @@ bitset_or <- function(a, b) {
     invisible(.Call(`_individual_bitset_or`, a, b))
 }
 
+bitset_copy_from <- function(a, b) {
+    invisible(.Call(`_individual_bitset_copy_from`, a, b))
+}
+
 bitset_xor <- function(a, b) {
     invisible(.Call(`_individual_bitset_xor`, a, b))
 }

R/bitset.R

@@ -210,10 +210,28 @@ Bitset <- list(
       #' ```{r echo=FALSE, results="asis"}
       #' bitset_method_doc(
       #'   "copy",
-      #'   "returns a copy of the bitset.")
+      #'   "returns a copy of the bitset.
+      #'
+      #'    In cases where a destination bitset already exists, it may be more
+      #'    performant to use the \\code{copy_from} method instead.")
       #' ```
       copy = function() Bitset$new(from = bitset_copy(self$.bitset)),
 
+
+      #' ```{r echo=FALSE, results="asis"}
+      #' bitset_method_doc(
+      #'   "copy_from",
+      #'   "overwrite the value of the bitset from another bitset.
+      #'
+      #'    This is similar to calling \\code{other$copy()}, but can be more
+      #'    efficient by reusing the resources of the existing bitset.",
+      #'   other = "the other bitset.")
+      #' ```
+      copy_from = function(other) {
+        bitset_copy_from(self$.bitset, other$.bitset)
+        self
+      },
+
       #' ```{r echo=FALSE, results="asis"}
       #' bitset_method_doc(
       #'   "to_vector",

src/RcppExports.cpp

@@ -124,6 +124,17 @@ BEGIN_RCPP
     return R_NilValue;
 END_RCPP
 }
+// bitset_copy_from
+void bitset_copy_from(const Rcpp::XPtr<individual_index_t> a, const Rcpp::XPtr<individual_index_t> b);
+RcppExport SEXP _individual_bitset_copy_from(SEXP aSEXP, SEXP bSEXP) {
+BEGIN_RCPP
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const Rcpp::XPtr<individual_index_t> >::type a(aSEXP);
+    Rcpp::traits::input_parameter< const Rcpp::XPtr<individual_index_t> >::type b(bSEXP);
+    bitset_copy_from(a, b);
+    return R_NilValue;
+END_RCPP
+}
 // bitset_xor
 void bitset_xor(const Rcpp::XPtr<individual_index_t> a, const Rcpp::XPtr<individual_index_t> b);
 RcppExport SEXP _individual_bitset_xor(SEXP aSEXP, SEXP bSEXP) {
@@ -1476,6 +1487,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_individual_bitset_and", (DL_FUNC) &_individual_bitset_and, 2},
     {"_individual_bitset_not", (DL_FUNC) &_individual_bitset_not, 2},
     {"_individual_bitset_or", (DL_FUNC) &_individual_bitset_or, 2},
+    {"_individual_bitset_copy_from", (DL_FUNC) &_individual_bitset_copy_from, 2},
     {"_individual_bitset_xor", (DL_FUNC) &_individual_bitset_xor, 2},
     {"_individual_bitset_set_difference", (DL_FUNC) &_individual_bitset_set_difference, 2},
     {"_individual_bitset_sample", (DL_FUNC) &_individual_bitset_sample, 2},

src/bitset.cpp

@@ -88,6 +88,17 @@ void bitset_or(
     (*a) |= (*b);
 }
 
+//[[Rcpp::export]]
+void bitset_copy_from(
+    const Rcpp::XPtr<individual_index_t> a,
+    const Rcpp::XPtr<individual_index_t> b
+    ) {
+    if (a->max_size() != b->max_size()) {
+        Rcpp::stop("Incompatible bitmap sizes");
+    }
+    (*a) = (*b);
+}
+
 //[[Rcpp::export]]
 void bitset_xor(
     const Rcpp::XPtr<individual_index_t> a,

tests/testthat/test-bitset.R

@@ -80,6 +80,31 @@ test_that("bitset or works", {
   expect_equal(a$to_vector(), c(1, 3, 5, 6, 7))
 })
 
+test_that("bitset copy from works", {
+  a <- Bitset$new(10)
+  a$insert(c(1, 5, 6))
+  b <- Bitset$new(10)
+  b$insert(c(1, 3, 7))
+
+  a$copy_from(b)
+  expect_equal(a$to_vector(), c(1, 3, 7))
+
+  # Check the two bitsets aren't aliases of each other.
+  b$clear()
+  expect_equal(a$to_vector(), c(1, 3, 7))
+  expect_equal(b$to_vector(), numeric(0))
+})
+
+test_that("bitset copy from requires bitsets to have same max size", {
+  a <- Bitset$new(8)
+  a$insert(c(1, 5, 6))
+  b <- Bitset$new(10)
+  b$insert(c(1, 3, 7))
+
+  expect_error(a$copy_from(b), "Incompatible bitmap sizes")
+})
+
+
 test_that("bitset set difference works for sets with intersection", {
 
   a <- Bitset$new(20)