Permalink
Switch branches/tags
Nothing to show
Find file Copy path
5458d97 Oct 17, 2018
2 contributors

Users who have contributed to this file

@romainfrancois @klmr
170 lines (133 sloc) 5.01 KB
#include "altrepisode.h"
// We need the std::vector template class, so that
// we can use std::vector<double>
#include <vector>
// instead of defining a set of free functions, we structure them
// together in a struct
struct stdvec_double {
// The altrep class that wraps a pointer to a std::vector<double>
static R_altrep_class_t class_t;
// Make an altrep object of class `stdvec_double::class_t`
static SEXP Make(std::vector<double>* data, bool owner){
// The std::vector<double> pointer is wrapped into an R external pointer
//
// `xp` needs protection because R_new_altrep allocates
SEXP xp = PROTECT(R_MakeExternalPtr(data, R_NilValue, R_NilValue));
// If we own the std::vector<double>*, we need to delete it
// when the R object is being garbage collected
if (owner) {
R_RegisterCFinalizerEx(xp, stdvec_double::Finalize, TRUE);
}
// make a new altrep object of class `stdvec_double::class_t`
SEXP res = R_new_altrep(class_t, xp, R_NilValue);
// xp no longer needs protection, as it has been adopted by `res`
UNPROTECT(1);
return res;
}
// finalizer for the external pointer
static void Finalize(SEXP xp){
delete static_cast<std::vector<double>*>(R_ExternalPtrAddr(xp));
}
// get the std::vector<double>* from the altrep object `x`
static std::vector<double>* Ptr(SEXP x) {
return static_cast<std::vector<double>*>(R_ExternalPtrAddr(R_altrep_data1(x)));
}
// same, but as a reference, for convenience
static std::vector<double>& Get(SEXP vec) {
return *Ptr(vec) ;
}
// ALTREP methods -------------------
// The length of the object
static R_xlen_t Length(SEXP vec){
return Get(vec).size();
}
// What gets printed when .Internal(inspect()) is used
static Rboolean Inspect(SEXP x, int pre, int deep, int pvec, void (*inspect_subtree)(SEXP, int, int, int)){
Rprintf("std::vector<double> (len=%d, ptr=%p)\n", Length(x), Ptr(x));
return TRUE;
}
// ALTVEC methods ------------------
// The start of the data, i.e. the underlying double* array from the std::vector<double>
//
// This is guaranteed to never allocate (in the R sense)
static const void* Dataptr_or_null(SEXP vec){
return Get(vec).data();
}
// same in this case, writeable is ignored
static void* Dataptr(SEXP vec, Rboolean writeable){
return Get(vec).data();
}
// ALTREAL methods -----------------
// the element at the index `i`
//
// this does not do bounds checking because that's expensive, so
// the caller must take care of that
static double real_Elt(SEXP vec, R_xlen_t i){
return Get(vec)[i];
}
// Get a pointer to the region of the data starting at index `i`
// of at most `size` elements.
//
// The return values is the number of elements the region truly is so the caller
// must not go beyond
static R_xlen_t Get_region(SEXP vec, R_xlen_t start, R_xlen_t size, double* out){
out = Get(vec).data() + start;
R_xlen_t len = Get(vec).size() - start;
return len > size ? len : size;
}
// -------- initialize the altrep class with the methods above
static void Init(DllInfo* dll){
class_t = R_make_altreal_class("stdvec_double", "altrepisode", dll);
// altrep
R_set_altrep_Length_method(class_t, Length);
R_set_altrep_Inspect_method(class_t, Inspect);
// altvec
R_set_altvec_Dataptr_method(class_t, Dataptr);
R_set_altvec_Dataptr_or_null_method(class_t, Dataptr_or_null);
// altreal
R_set_altreal_Elt_method(class_t, real_Elt);
R_set_altreal_Get_region_method(class_t, Get_region);
}
};
// static initialization of stdvec_double::class_t
R_altrep_class_t stdvec_double::class_t;
// Called the package is loaded (needs Rcpp 0.12.18.3)
// [[Rcpp::init]]
void init_stdvec_double(DllInfo* dll){
stdvec_double::Init(dll);
}
//' an altrep object that wraps a std::vector<double>
//'
//' @export
// [[Rcpp::export]]
SEXP doubles() {
// create a new std::vector<double>
//
// this uses `new` because we want the vector to survive
// it is deleted when the altrep object is garbage collected
auto v = new std::vector<double> {-2.0, -1.0, 0.0, 1.0, 2.0};
// The altrep object owns the std::vector<double>
return stdvec_double::Make(v, true);
}
// example C++ function that returns `n` random number between 0 and 1
std::vector<double> randoms(int n){
std::vector<double> v(n);
std::generate(begin(v), end(v), [] { return (double)std::rand() / RAND_MAX ; } );
return v;
}
// [[Rcpp::export]]
SEXP doubles_example(){
// get a std::vector<double> from somewhere
auto v = randoms(10);
// wrap it into an altrep object of class `stdvec_double::class_t`
// the altrep object does not own the vector, because we only need
// it within this scope, it will be deleted just like any C++ object
// at the end of this C++ function
SEXP x = PROTECT(stdvec_double::Make(&v, false));
// call sum(x) in the base environment
SEXP s_sum = Rf_install("sum");
SEXP call = PROTECT(Rf_lang2(s_sum, x));
SEXP res = Rf_eval(call, R_BaseEnv);
UNPROTECT(2);
return res;
}