#include <Rinternals.h> class MyObject{ public: int type; MyObject(int t):type(t){} }; void finalizeMyObject(SEXP ptr){ MyObject * mo= static_cast<MyObject *>(R_ExternalPtrAddr(ptr)); delete mo; } extern "C" { SEXP CreateObject(SEXP type) { SEXP ans; int nb = length(type); PROTECT(ans=allocVector(VECSXP,nb)); int * typeP = INTEGER(type); SEXP cl; PROTECT(cl = allocVector(STRSXP,1)); SET_STRING_ELT(cl,mkChar("myObject")); for(int i=0; i<nb; i++){ MyObject * mo = new MyObject(typeP[i]); SEXP tmpObj = R_MakeExternalPtr(mo,R_NilValue,R_NilValue); R_RegisterCFinalizerEx(tmpObj,(R_CFinalizer_t) finalizeMyObject,TRUE); classgets(tmpObj,cl); SET_VECTOR_ELT(ans,i,tmpObj);//Put in vector } UNPROTECT(2); return ans; } SEXP printMyObject(SEXP myObjects){ int nb = length(myObjects); for(int i=0; i<nb; i++){ SEXP moS=VECTOR_ELT(myObjects,i); MyObject * mo= static_cast<MyObject *>(R_ExternalPtrAddr(moS)); Rprintf("%d\n",mo->type); } return R_NilValue; } }
构建内部数据结构后,可以调用多个函数来计算不同的统计信息.上面的函数printMyObject提供了这样的函数的一个例子.
尝试保存此内部结构时出现问题.它似乎保存了指针地址.重新加载对象时,我们会遇到段错误.这是一个示例R代码(假设myobject.cpp包含上面的代码并编译为myobject.dll)
dyn.load("myobject.dll") ## Create the internal data structure xx <- .Call("CreateObject",1:10) ##Everything is fine .Call("printMyObject",xx) ## Save it,no errors save(xx,file="xx.RData") ## remove all objects rm(list=ls()) ## Load the data load(file="xx.RData") ##segfault .Call("printMyObject",xx)
我的问题是:正确处理这个问题的最佳方法是什么?我考虑过一些策略,但除了第一个策略之外,我不知道它是如何完成的(如果有可能的话):
>不要返回内部对象.用户总是将R结构内部转换(对于每个函数调用,例如print等)到内部C结构.优点:无需segfault即可保存数据.缺点:这是非常低效的,特别是当有大量数据时.
>将对象存储为R和C结构,并尝试弄清楚(我不知道如何)C结构是否已损坏以重建它.优点:内部数据结构每个会话只构建一次.缺点:不是最好的内存问题(数据存储两次).
>仅使用C结构,永不保存/加载(使用实际解决方案).问题是没有错误消息,只是一个段错误.
>使用R保存/加载功能时,找到一种序列化内部C对象的方法.
任何想法/建议都非常受欢迎.
解决方法
>使用R Raw数据类型存储C对象.这具有记忆效率的优点,但在实践中它非常复杂.就个人而言,我不会将它用于一个大项目,因为内存管理可能很乏味.当然,使用模板类可能会有一些改进(请分享,如果您有想法).
>将对象存储为R和C结构,并在重新加载后重建C对象. C对象只构建一次(不是每个函数调用),但数据存储两次.这具有在大型项目上更容易实现的重要优点.
为了展示这些解决方案,我使用了一个稍微复杂的例子来突出第一个解决方案的复杂性.在这个例子中,我们的示例C对象是一种链表.
第一种解决方案:使用R RAW数据
这个想法(由@KarlForner提出)是使用R Raw数据类型来存储对象的内容.在实践中,这意味着:
>使用R Raw数据类型分配内存.
>确保分配正确的内存量(这可能很复杂).
>使用placement new在指定的内存地址(具有原始数据的地址)创建C对象.
这是文件“myobject.cpp”:
#include <Rinternals.h> #include <new> //Our example Object: A linked list. class MyRawObject{ int type; // Next object in the list. bool hasnext; public: MyRawObject(int t):type(t),hasnext (false){ if(t>1){ //We build a next object. hasnext = true; //Here we use placement new to build the object in the next allocated memory // No need to store a pointer. //We know that this is in the next contiguous location (see memory allocation below) new (this+1) MyRawObject(t-1); } } void print(){ Rprintf(" => %d ",type); if(this->hasnext){ //Next object located is in the next contiguous memory block (this+1)->print(); //Next in allocated memory } } }; extern "C" { SEXP CreateRawObject(SEXP type) { SEXP ans; int nb = length(type); PROTECT(ans=allocVector(VECSXP,nb)); int * typeP = INTEGER(type); //When allocating memory,we need to know the size of our object. int MOsize =sizeof(MyRawObject); for(int i=0; i<nb; i++){ SEXP rawData; //Allocate the memory using R RAW data type. //Take care to allocate the right amount of memory //Here we have typeP[i] objects to create. PROTECT(rawData=allocVector(RAWSXP,typeP[i]*MOsize)); //Memory address of the allocated memory unsigned char * buf = RAW(rawData); //Here we use placement new to build the object in the allocated memory new (buf) MyRawObject(typeP[i]); SET_VECTOR_ELT(ans,rawData);//Put in vector UNPROTECT(1); } UNPROTECT(1); return ans; } SEXP printRawObject(SEXP myObjects){ int nb = length(myObjects); for(int i=0; i<nb; i++){ SEXP moS=VECTOR_ELT(myObjects,i); //Use reinterpret_cast to have a pointer of type MyRawObject pointing to the RAW data MyRawObject * mo= reinterpret_cast<MyRawObject *>(RAW(moS)); if(mo!=NULL){ Rprintf("Address: %d",mo); mo->print(); Rprintf("\n"); }else{ Rprintf("Null pointer!\n"); } } return R_NilValue; } }
这些函数可以直接在R中使用,例如:
## Create the internal data structure xx <- .Call("CreateRawObject",1:10) ##Print .Call("printRawObject",xx) ## Save it save(xx,file="xxRaw.RData") ## remove all objects rm(xx) ## Load the data load(file="xxRaw.RData") ##Works ! .Call("printRawObject",xx)
此解决方案存在几个问题:
>不会调用析构函数(取决于您在析构函数中执行的操作,这可能是一个问题).
>如果您的类包含指向其他对象的指针,则所有指针都应该相对于内存位置,以便在重新加载后使其工作(如此处使用链接列表).
>这很复杂.
>我不确定保存的文件(.RData)是否是跨平台的(在计算机上共享RData文件是否安全?),因为我不确定用于存储对象的内存是否相同在所有平台上.
第二种解决方案:将对象存储为R和C结构,并在重新加载后重建C对象.
我们的想法是在每个函数调用中检查C指针是否正确.如果没有,则重建对象,否则忽略该步骤.这是可能的,因为我们直接修改(在C中)R对象.因此,此更改将对所有后续呼叫生效.优点是C对象只构建一次(不是每个函数调用),但数据存储两次.这具有在大型项目上更容易实现的重要优点.
在文件“myobject.cpp”中.
#include <Rinternals.h> //Our object can be made simpler because we can use pointers class MyObject{ int type; //Pointer to the next object MyObject *next; public: MyObject(int t):type(t),next(NULL){ if(t>1){ next = new MyObject(t-1); } } ~MyObject(){ if(this->next!=NULL){ delete next; } } void print(){ Rprintf(" => %d ",type); if(this->next!=NULL){ this->next->print(); } } }; void finalizeMyObject(SEXP ptr){ MyObject * mo= static_cast<MyObject *>(R_ExternalPtrAddr(ptr)); delete mo; } extern "C" { SEXP CreateObject(SEXP type) { SEXP ans; int nb = length(type); PROTECT(ans=allocVector(VECSXP,i); MyObject * mo= static_cast<MyObject *>(R_ExternalPtrAddr(moS)); if(mo!=NULL){ Rprintf("Address: %d",mo); mo->print(); Rprintf("\n"); }else{ Rprintf("Null pointer!\n"); } } return R_NilValue; } //This function check if a C++ object is NULL,if it is,it rebuilds all the C++ objects. SEXP checkRebuildMyObject(SEXP myObjects,SEXP type){ int nb = length(myObjects); if(nb==0){ return R_NilValue; } if(R_ExternalPtrAddr(VECTOR_ELT(myObjects,1))){ //Non corrupted ptrs return R_NilValue; } int * typeP = INTEGER(type); SEXP cl; PROTECT(cl = allocVector(STRSXP,TRUE); classgets(tmpObj,cl); SET_VECTOR_ELT(myObjects,tmpObj);//Put in vector } UNPROTECT(1); return R_NilValue; } }
在R方面,我们可以使用以下功能:
dyn.load("myobject.dll") CreateObjectR <- function(type){ ## We use a custom object type,that store both C++ and R data type <- as.integer(type) mo <- list(type=type,myObject= .Call("CreateObject",type)) class(mo) <- "myObjectList" return(mo) } print.myObjectList <- function(x,...){ ## Be sure to check the C++ objects before calling the functions. .Call("checkRebuildMyObject",x$myObject,x$type) .Call("printMyObject",x$myObject) invisible() } xx <- CreateObjectR(1:10) print(xx) save(xx,file="xx.RData") rm(xx) load(file="xx.RData") print(xx)