在R中,我使用内部C结构来存储数据(使用R_ExternalPtr).然后可以使用各种功能处理数据.这是一个简单的例子(真正的数据结构要复杂得多)：
#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对象的方法.
任何想法/建议都非常受欢迎.
解决方法
最后,我找到了2个解决方案来正确处理带有C对象的R保存/加载机制(数据持久性).没有一个是完美的,但它似乎比什么都不做要好.不久,这些解决方案(详情如下)：
>使用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)
