编写 R 扩展时如何返回命名的 VECSXP答案

【问题标题】：How to return a named VECSXP when writing R extensions编写 R 扩展时如何返回命名的 VECSXP
【发布时间】：2016-07-12 20:24:18
【问题描述】：

最近我遇到了一个错误，在修复它时我想知道是否可以返回一个 VECSXP（即 R 列表类型），其中元素被命名。这个 c++ 代码：

SEXP do_bla() 
{
   int prtCnt = 0;
   SEXP a = PROTECT(allocMatrix(REALSXP, 5, 5));
   prtCnt++;
   SEXP b = PROTECT(allocVector(REALSXP, 5));
   prtCnt++;
   SEXP OS = PROTECT(allocVector(VECSXP, 2));
   prtCnt++;
   SET_VECTOR_ELT(OS, 0, a);
   SET_VECTOR_ELT(OS, 1, b);
   UNPROTECT(prtCnt);
   return OS;
}

会给我一个 R 中两个元素（矩阵和向量）的列表：

s <- .Call("do_bla", ....)

可以这样索引：

 s[[1]]; s[[2]]

为了实现这一点，我需要做出哪些改变：

s$a; s$b

或者这不可能？

【问题讨论】：

标签： c r s-expression r-extension

【解决方案1】：

请参阅Writing R Extensions 的第 5.9.4 节。分配并填充名称向量，并在列表中设置名称属性。

library(inline)
named <- cfunction(signature(), '
    /* allocate and populate list */
    SEXP OS = PROTECT(allocVector(VECSXP, 2));
    SET_VECTOR_ELT(OS, 0, allocMatrix(REALSXP, 5, 5));
    SET_VECTOR_ELT(OS, 1, allocVector(REALSXP, 5));

    /* create names */
    SEXP nms = PROTECT(allocVector(STRSXP, 2));
    SET_STRING_ELT(nms, 0, mkChar("foo"));
    SET_STRING_ELT(nms, 1, mkChar("bar"));

    /* assign names to list */
    setAttrib(OS, R_NamesSymbol, nms);

    /* cleanup and return */
    UNPROTECT(2);
    return OS;')

【讨论】：

【解决方案2】：

使用 R 的 C API 函数可能有一种更惯用的方法来做到这一点——我倾向于通过 Rcpp 坚持使用 C++，因为它更安全、更简洁——但添加以下内容应该可以：

 SEXP n = PROTECT(Rf_allocVector(STRSXP, 2));
 prtCnt++;
 SET_STRING_ELT(n, 0, Rf_mkChar("a"));
 SET_STRING_ELT(n, 1, Rf_mkChar("b"));
 Rf_setAttrib(OS, R_NamesSymbol, n);

但是，我强烈建议使用 Rcpp，因为您可以消除 R 的 C 函数附带的大部分样板。这里有两种选择，以及原始函数的修改版本：

#include <Rcpp.h>

// [[Rcpp::export]]
SEXP do_bla() {
   int prtCnt = 0;
   SEXP a = PROTECT(Rf_allocMatrix(REALSXP, 5, 5));
   prtCnt++;
   SEXP b = PROTECT(Rf_allocVector(REALSXP, 5));
   prtCnt++;
   SEXP OS = PROTECT(Rf_allocVector(VECSXP, 2));
   prtCnt++;
   SET_VECTOR_ELT(OS, 0, a);
   SET_VECTOR_ELT(OS, 1, b);

   SEXP n = PROTECT(Rf_allocVector(STRSXP, 2));
   prtCnt++;
   SET_STRING_ELT(n, 0, Rf_mkChar("a"));
   SET_STRING_ELT(n, 1, Rf_mkChar("b"));
   Rf_setAttrib(OS, R_NamesSymbol, n);

   UNPROTECT(prtCnt);
   return OS;
}

// [[Rcpp::export]]
SEXP do_bla2() {
    return Rcpp::List::create(
        Rcpp::Named("a") = Rcpp::NumericMatrix(5, 5),
        Rcpp::Named("b") = Rcpp::NumericVector(5));
}

// [[Rcpp::export]]
SEXP do_bla3() {
    Rcpp::NumericMatrix m(5, 5);
    Rcpp::NumericVector v(5);
    Rcpp::List res = Rcpp::List::create(m, v);
    res.names() = Rcpp::CharacterVector::create("a", "b");
    return res;
}

如果您直接使用<Rinternals.h>，您可能需要使用mkChar 和setAttrib 而不是Rf_mkChar 和Rf_setAttrib。

do_bla()
# $a
#               [,1]          [,2]          [,3]          [,4]          [,5]
# [1,] 2.371515e-322 4.743030e-322 9.654277e-315 8.695555e-322 6.518868e-310
# [2,] 2.794759e-316 2.371515e-322 6.763004e-317 2.371515e-322 6.952759e-310
# [3,] 3.458460e-323 2.797257e-316 1.630417e-322 2.852530e-316 1.630417e-322
# [4,] 6.441834e+170 1.976263e-323 4.092581e-316 1.976263e-323 4.125824e-316
# [5,] 1.818440e-306 6.952931e-310 4.008825e-316 2.121996e-314 2.154669e-316
# 
# $b
# [1] 2.144130e-316 2.168146e-316 3.468674e-316 2.155101e-316 2.172224e-316
# 
do_bla2()
# $a
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    0    0    0    0    0
# [2,]    0    0    0    0    0
# [3,]    0    0    0    0    0
# [4,]    0    0    0    0    0
# [5,]    0    0    0    0    0
# 
# $b
#[1] 0 0 0 0 0

do_bla3()
# $a
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    0    0    0    0    0
# [2,]    0    0    0    0    0
# [3,]    0    0    0    0    0
# [4,]    0    0    0    0    0
# [5,]    0    0    0    0    0
# 
# $b
#[1] 0 0 0 0 0

【讨论】：