带有指向C结构的指针的S4对象

pbh*_*ick 3 c r rcpp s4

我有一个第三方C库,用于编写R扩展.我需要创建一些在库中定义的结构(并初始化它们)我需要将它们作为S4对象的一部分进行维护(将这些结构视为定义计算状态,销毁它们将破坏所有剩余的计算和已经计算过的所有结果).我正在考虑创建一个S4对象来保存指针这些结构作为void*指针,但它根本不清楚如何这样做,插槽的类型是什么?

nru*_*ell 7

正如@hrbrmstr所指出的,您可以使用该externalptr类型来保持这些对象"活着",这在写入R扩展的这一部分中有所涉及,尽管我没有看到任何理由您需要存储任何内容void*.如果使用一点C++没有任何问题,Rcpp类XPtr可以消除管理EXTPTRSXPs所涉及的大量样板.例如,假设以下简化示例代表您的第三方库的API:

#include <Rcpp.h>
#include <stdlib.h>

typedef struct {
    unsigned int count;
    double total;
} CStruct;

CStruct* init_CStruct() {
    return (CStruct*)::malloc(sizeof(CStruct));
}

void free_CStruct(CStruct* ptr) {
    ::free(ptr);
    ::printf("free_CStruct called.\n");
}

typedef Rcpp::XPtr<CStruct, Rcpp::PreserveStorage, free_CStruct> xptr_t;
Run Code Online (Sandbox Code Playgroud)

使用通过new它创建的指针通常就足够了Rcpp::XPtr<SomeClass>,因为默认的终结器只是调用delete保持的对象.但是,由于您正在处理C API,我们必须提供(默认)模板参数Rcpp::PreserveStorage,更重要的是,提供适当的终结器(free_CStruct在此示例中),以便XPtr不会调用delete通过malloc等分配的内存,当相应的R对象被垃圾收集.

继续该示例,假设您编写以下函数来与您进行交互CStruct:

// [[Rcpp::export]]
xptr_t MakeCStruct() {
    CStruct* ptr = init_CStruct();
    ptr->count = 0;
    ptr->total = 0;

    return xptr_t(ptr, true);
}

// [[Rcpp::export]]
void UpdateCStruct(xptr_t ptr, SEXP x) {
    if (TYPEOF(x) == REALSXP) {
        R_xlen_t i = 0, sz = XLENGTH(x);
        for ( ; i < sz; i++) {
            if (!ISNA(REAL(x)[i])) {
                ptr->count++;
                ptr->total += REAL(x)[i];
            }
        }
        return;
    }

    if (TYPEOF(x) == INTSXP) {
        R_xlen_t i = 0, sz = XLENGTH(x);
        for ( ; i < sz; i++) {
            if (!ISNA(INTEGER(x)[i])) {
                ptr->count++;
                ptr->total += INTEGER(x)[i];
            }
        }
        return;
    }

    Rf_warning("Invalid SEXPTYPE.\n");
}

// [[Rcpp::export]]
void SummarizeCStruct(xptr_t ptr) {
    ::printf(
        "count: %d\ntotal: %f\naverage: %f\n",
        ptr->count, ptr->total,
        ptr->count > 0 ? ptr->total / ptr->count : 0
    );
}

// [[Rcpp::export]]
int GetCStructCount(xptr_t ptr) {
    return ptr->count;
}

// [[Rcpp::export]]
double GetCStructTotal(xptr_t ptr) {
    return ptr->total;
}

// [[Rcpp::export]]
void ResetCStruct(xptr_t ptr) {
    ptr->count = 0;
    ptr->total = 0.0;
}
Run Code Online (Sandbox Code Playgroud)

此时,您已经做了足够的事情CStructs从R 开始处理:

  • ptr <- MakeCStruct()将初始化a CStruct并将其存储为externalptrR中
  • UpdateCStruct(ptr, x)将修改存储在的数据CStruct,SummarizeCStruct(ptr)将打印摘要等.
  • rm(ptr); gc()将删除ptr对象并强制垃圾收集器运行,从而调用free_CStruct(ptr)和销毁C端的对象

您提到了S4类的使用,这是在一个地方包含所有这些功能的一种选择.这是一种可能性:

setClass(
    "CStruct",
    slots = c(
        ptr = "externalptr",
        update = "function",
        summarize = "function",
        get_count = "function",
        get_total = "function",
        reset = "function"
    )
)

setMethod(
    "initialize",
    "CStruct",
    function(.Object) {
        .Object@ptr <- MakeCStruct()
        .Object@update <- function(x) {
            UpdateCStruct(.Object@ptr, x)
        }
        .Object@summarize <- function() {
            SummarizeCStruct(.Object@ptr)
        }
        .Object@get_count <- function() {
            GetCStructCount(.Object@ptr)
        }
        .Object@get_total <- function() {
            GetCStructTotal(.Object@ptr)
        }
        .Object@reset <- function() {
            ResetCStruct(.Object@ptr)
        }
        .Object
    }
) 
Run Code Online (Sandbox Code Playgroud)

然后,我们可以CStruct像这样使用s:

ptr <- new("CStruct")
ptr@summarize()
# count: 0
# total: 0.000000
# average: 0.000000

set.seed(123)
ptr@update(rnorm(100))
ptr@summarize()
# count: 100
# total: 9.040591
# average: 0.090406

ptr@update(rnorm(100))
ptr@summarize()
# count: 200
# total: -1.714089
# average: -0.008570

ptr@reset()
ptr@summarize()
# count: 0
# total: 0.000000
# average: 0.000000

rm(ptr); gc()
# free_CStruct called.
#          used (Mb) gc trigger (Mb) max used (Mb)
# Ncells 484713 25.9     940480 50.3   601634 32.2
# Vcells 934299  7.2    1650153 12.6  1308457 10.0
Run Code Online (Sandbox Code Playgroud)

当然,另一个选择是使用Rcpp模块,它或多或少地处理R侧的类定义样板(但是使用引用类而不是S4类).

  • 很好的答案.可能(应该?)也可能是Rcpp Gallery的帖子! (4认同)