get_bit switched to C++

ravenguard117 · Mar 9, 2018 · 2967a39 · 2967a39
1 parent 8cd57d0
commit 2967a39
Show file tree

Hide file tree

Showing 6 changed files with 43 additions and 42 deletions.
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -25,6 +25,10 @@ do_geod_xy_inverse <- function(x, y, lonr, latr, a, f) {
     .Call(`_oce_do_geod_xy_inverse`, x, y, lonr, latr, a, f)
 }
 
+do_get_bit <- function(buf, bit) {
+    .Call(`_oce_do_get_bit`, buf, bit)
+}
+
 do_gradient <- function(m, x, y) {
     .Call(`_oce_do_gradient`, m, x, y)
 }

diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -96,6 +96,18 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// do_get_bit
+NumericVector do_get_bit(RawVector buf, int bit);
+RcppExport SEXP _oce_do_get_bit(SEXP bufSEXP, SEXP bitSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< RawVector >::type buf(bufSEXP);
+    Rcpp::traits::input_parameter< int >::type bit(bitSEXP);
+    rcpp_result_gen = Rcpp::wrap(do_get_bit(buf, bit));
+    return rcpp_result_gen;
+END_RCPP
+}
 // do_gradient
 List do_gradient(NumericMatrix m, NumericVector x, NumericVector y);
 RcppExport SEXP _oce_do_gradient(SEXP mSEXP, SEXP xSEXP, SEXP ySEXP) {

diff --git a/src/get_bit.c b/src/get_bit.c
diff --git a/src/get_bit.cpp b/src/get_bit.cpp
@@ -0,0 +1,24 @@
+/* vim: set expandtab shiftwidth=2 softtabstop=2 tw=70: */
+
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// Cross-reference work:
+// 1. update ../src/registerDynamicSymbol.c with an item for this
+// 2. main code should use the autogenerated wrapper in ../R/RcppExports.R
+//
+// [[Rcpp::export]]
+NumericVector do_get_bit(RawVector buf, int bit) // bit=0 for rightmost bit, =7 for leftmost bit
+{
+  static unsigned char mask[] = {1, 2, 4, 8, 16, 32, 64, 128};
+  int n = buf.size();
+  if (bit < 0)
+    ::Rf_error("cannot have bit number less than 0; got %d", bit);
+  if (bit > 7)
+    ::Rf_error("cannot have bit number greater than 7; got %d", bit);
+  NumericVector res(n);
+  for (int i = 0; i < n; i++) {
+    res[i] = (buf[i] & mask[bit]) != 0;
+  }
+  return(res);
+}
diff --git a/src/registerDynamicSymbol.c b/src/registerDynamicSymbol.c
@@ -8,6 +8,7 @@ extern SEXP _oce_do_geoddist(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP f);
 extern SEXP _oce_do_geoddist_alongpath(SEXP, SEXP, SEXP, SEXP f);
 extern SEXP _oce_do_geod_xy(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP _oce_do_geod_xy_inverse(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
+extern SEXP _oce_do_get_bit(SEXP, int);
 extern SEXP _oce_do_oceApprox(SEXP, SEXP, SEXP, SEXP);
 extern SEXP _oce_do_gradient(SEXP, SEXP, SEXP);
 extern SEXP _oce_do_oce_convolve(SEXP, SEXP, SEXP);
@@ -24,6 +25,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_oce_do_geod_xy", (DL_FUNC) &_oce_do_geod_xy, 6},
     {"_oce_do_geod_xy_inverse", (DL_FUNC) &_oce_do_geod_xy_inverse, 6},
     {"_oce_do_geoddist_alongpath", (DL_FUNC) &_oce_do_geoddist_alongpath, 4},
+    {"_oce_do_get_bit", (DL_FUNC) &_oce_do_get_bit, 2},
     {"_oce_do_gradient", (DL_FUNC) &_oce_do_gradient, 3},
     {"_oce_do_oceApprox", (DL_FUNC) &_oce_do_oceApprox, 4},
     {"_oce_do_oce_filter", (DL_FUNC) &_oce_do_oce_filter, 3},

diff --git a/tests/testthat/test_misc.R b/tests/testthat/test_misc.R
@@ -168,7 +168,7 @@ test_that("fillGap", {
 
 test_that("get_bit (unused in oce)", {
           buf <- 0x3a
-          bits <- unlist(lapply(7:0, function(i) .Call("get_bit", buf, i)))
+          bits <- unlist(lapply(7:0, function(i) oce:::do_get_bit(buf, i)))
           ## NB. 'i' starts at rightmost bit
           expect_equal(c(0, 0, 1, 1, 1, 0, 1, 0), bits)
 })