用于擦除NA值的模板化Rcpp函数

我将编写一个函数（使用

Rcpp

），从

R

向量中删除所有

NA

值

在此之前，我通过

Rcpp:：cppFunction

函数做了一点测试

library(inline)
cppFunction('
  Vector<INTSXP> na_test(const Vector<INTSXP>& x) {
    return setdiff(x, Vector<INTSXP>::create(::traits::get_na<INTSXP>()));
  }
')

之后，我尝试通过

C++

模板机制来概括这个函数

因此，在一个外部.cpp文件（通过

sourceCpp

函数获得）中，我写了：

template <int RTYPE>
Vector<RTYPE> na_test_template(const Vector<RTYPE>& x) {
    return setdiff(x, Vector<RTYPE>::create(::traits::get_na<RTYPE>()));
}

// [[Rcpp::export(na_test_cpp)]]
SEXP na_test(SEXP x) {
    switch(TYPEOF(x)) {
        case INTSXP:
            return na_test_template<INTSXP>(x);
        case REALSXP:
            return na_test_template<REALSXP>(x);
    }
    return R_NilValue;
}

---

为什么相同的功能（显然）表现不同？这里发生了什么？

模板机制似乎工作正常

> na_test_cpp(as.numeric(c(1, NA, NA, 1, 2, NA)))
[1]  2 NA NA NA  1

> na_test_cpp(as.integer(c(1, NA, NA, 1, 2, NA)))
[1] 1 2

这段代码适用于INTSXP，但不适用于REALSXP

Vector<REALSXP> na_test_real(const Vector<REALSXP>& x) {
  return setdiff(x, Vector<REALSXP>::create(::traits::get_na<REALSXP>()));
}

Vector na_test_real（const Vector&x）{
返回setdiff（x，Vector:：create（：：traits:：get_na（））；
}

我继续研究有关模板问题的解决方案（即，请参阅@Sameer reply）

所以我编写了另一个函数，现在模板机制可以工作了

在外部

.cpp

文件中：

#include <Rcpp.h>
template <int RTYPE, class T>
Vector<RTYPE> na_omit_template(const Vector<RTYPE>& x) {
    typedef typename Vector<RTYPE>::iterator rvector_it;
    if (x.size() == 0) {
        return x;
    }
    std::vector<T> out;
    rvector_it it = x.begin();
    for (; it != x.end(); ++it) {
        if (!Vector<RTYPE>::is_na(*it)) {
            out.push_back(*it);
        }
    }
    return wrap(out);
}

// [[Rcpp::export(na_omit_cpp)]]
SEXP na_omit(SEXP x) {
    switch(TYPEOF(x)) {
        case INTSXP:
            return na_omit_template<INTSXP, int>(x);
        case REALSXP:                   
            return na_omit_template<REALSXP, double>(x);
        case LGLSXP:
            return na_omit_template<LGLSXP, bool>(x);
        case CPLXSXP:
            return na_omit_template<CPLXSXP, Rcomplex>(x);
        case RAWSXP:
            return na_omit_template<RAWSXP, Rbyte>(x);
        default:
            stop("unsupported data type");
    }
}

因此，除了

原始

向量和

复杂

向量之外，该函数几乎在所有情况下都有效

当前未解决的问题包括：

我不确定为什么会出现这种错误，我想找出原因。有什么想法吗

如@Sameer所示，前面的模板函数有一个奇怪的行为

如何接受

字符

向量

---

我清楚地想到了

case STRSXP：返回na_ommit_模板（x）

但是这句话用

std:：string

，

Rcpp:string

替换为

？

在你的回答之后，我会使用类似这样的模板：

template <int RTYPE>
Vector<RTYPE> na_omit_template(const Vector<RTYPE>& x) {
    int n = x.size() ;
    int n_out = n - sum( is_na(x) ) ;

    Vector<RTYPE> out(n_out) ;
    for( int i=0, j=0; i<n; i++){
        if( Vector<RTYPE>::is_na( x[i] ) ) continue ;
        out[j++] = x[i];
    }
    return out ;
}

na_omit

已包含在

Rcpp

（svn修订版>=4309）中，只做了一些修改，即它可以处理命名向量和任意sugar表达式

一些实现：

//天真
模板
向量na_省略_impl（常量向量和x）{
std:：size_t n=x.size（）；
//估算出长度
std:：size\u t n\u out=0；
对于（标准：：大小\u t i=0；i

所有实现都使用

RCPP\u RETURN\u VECTOR

宏：

/[[Rcpp:：export]]
RObject na_省略（RObject x）{
RCPP_返回_向量（na_省略_impl，x）；
}

您的示例调用na_test_cpp，而您的代码没有显示它。此表达式

/[[Rcpp:：export（na_test_cpp）]]

不需要导出函数（使用所需的名称）？我的缺点是，忽略了它的优点！我开始认为这可能是与

setdiff

函数有关的问题，但我不确定。这就是为什么我写在这里，希望一些大师能帮助我：）那是因为

>evalCpp（“NA_REAL==NA_REAL”）

给出了

[1]FALSE

。你不能用数字NA测试是否相等，你必须使用

is\u NA

。我稍后会给出实际答复。在原始向量的情况下，没有NA这样的东西。@romainconcois你是对的，我应该知道（）。无论如何，我仍在尝试使这个函数适用于字符向量。目前：无进展。

case STRSXP：返回na_-omit_模板（x）有效。非常优雅的解决方案！；）有没有办法让它与STRSXP和CPLXSXP向量一起工作？对我来说
STRSXP
。复杂版本不起作用，因为
Rcpp
中有一个bug，现已在4308版中修复。我在
Rcpp
中添加了
na_omit
，只做了一些修改，例如，它可以处理命名向量和任意糖表达式。非常好！因为我希望使用您添加到
Rcpp
：新的relase时？：）的
na_omit
）或者我可以从你的SVN安装它？现在新版本正在计划中。我们不会为每个新功能或错误修复发布。只需从r-forge获取源代码并自己构建：
svn checkoutsvn://svn.r-forge.r-project.org/svnroot/rcpp/pkg/Rcpp
#include <Rcpp.h>
template <int RTYPE, class T>
Vector<RTYPE> na_omit_template(const Vector<RTYPE>& x) {
    typedef typename Vector<RTYPE>::iterator rvector_it;
    if (x.size() == 0) {
        return x;
    }
    std::vector<T> out;
    rvector_it it = x.begin();
    for (; it != x.end(); ++it) {
        if (!Vector<RTYPE>::is_na(*it)) {
            out.push_back(*it);
        }
    }
    return wrap(out);
}

// [[Rcpp::export(na_omit_cpp)]]
SEXP na_omit(SEXP x) {
    switch(TYPEOF(x)) {
        case INTSXP:
            return na_omit_template<INTSXP, int>(x);
        case REALSXP:                   
            return na_omit_template<REALSXP, double>(x);
        case LGLSXP:
            return na_omit_template<LGLSXP, bool>(x);
        case CPLXSXP:
            return na_omit_template<CPLXSXP, Rcomplex>(x);
        case RAWSXP:
            return na_omit_template<RAWSXP, Rbyte>(x);
        default:
            stop("unsupported data type");
    }
}

library(Rcpp)
sourceCpp('file.cpp')
na_omit_cpp(as.integer(c(1, NA, NA, 1, 2, NA))) # OK
# [1] 1 1 2
na_omit_cpp(as.numeric(c(1, NA, NA, 1, 2, NA)))
# [1] 1 1 2
na_omit_cpp(c(NA, 1L, NA, 3L, NA)) # OK
# [1] 1 3
na_omit_cpp(c(NA, 2L, 1, NA)) # OK
# [1] 2 1
na_omit_cpp(c(1.0, 1.1, 2.2, NA, 3, NA, 4)) # OK
# [1] 1.0 1.1 2.2 3.0 4.0
na_omit_cpp(c(1L, NaN, NaN, 0, NA)) # OK
# [1]   1 NaN NaN   0
na_omit_cpp(c(NA, NaN, 1.0, 0.0, 2.2, NA, 3.3, NA, 4.4)) # OK
# [1] NaN 1.0 0.0 2.2 3.3 4.4
na_omit_cpp(as.logical(c(1, 0, 1, NA))) # OK
# [1]  TRUE FALSE  TRUE
na_omit_cpp(as.logical(c(TRUE, FALSE, NA, TRUE, NA))) # OK
# [1]  TRUE FALSE  TRUE
# empty vectors ?
na_omit_cpp(c(NA)) # OK
# logical(0)
na_omit_cpp(numeric(0)) # OK
# numeric(0)
na_omit_cpp(logical(0)) # OK
# logical(0)
na_omit_cpp(raw(0)) # OK
# raw(0)
na_omit_cpp(as.raw(c(40,16,NA,0,2))) # NO! (R converts it to 00)
# [1] 28 10 00 00 02
# Warning message ...
na_omit_cpp(as.complex(c(-1, 2, 1, NA, 0, NA, -1))) # NO! 
# [1] -1+0i  2+0i  1+0i    NA  0+0i    NA -1+0i

template <int RTYPE>
Vector<RTYPE> na_omit_template(const Vector<RTYPE>& x) {
    int n = x.size() ;
    int n_out = n - sum( is_na(x) ) ;

    Vector<RTYPE> out(n_out) ;
    for( int i=0, j=0; i<n; i++){
        if( Vector<RTYPE>::is_na( x[i] ) ) continue ;
        out[j++] = x[i];
    }
    return out ;
}

// [[Rcpp::export]]
SEXP na_omit( SEXP x ){
     RCPP_RETURN_VECTOR( na_omit_template, x ) ;   
}