Question

这是一个R方法，我想转换成c ++以加快速度

setMethod("[[", signature=signature(x="ncdfFlowSet"),
               definition=function(x, i, j, use.exprs = TRUE, ...)
{
  #subset by j
  if(!missing(j)){
    if(is.character(j)){
      j <- match(j, localChNames)
      if(any(is.na(j)))
        stop("subscript out of bounds")
    }  

    fr@parameters <- fr@parameters[j, , drop = FALSE]
    localChNames <- localChNames[j]
  }

  #other stuff

})

Kevin对vector subsetting的精彩工作让我的生活变得轻松j子集

    // [[Rcpp::export]]
    Rcpp::S4 readFrame(Rcpp::S4 x
                        , std::string sampleName
                        , Rcpp::RObject j_obj
                        , bool useExpr
                        )
    {
        Rcpp::Environment frEnv = x.slot("frames");
        Rcpp::S4 frObj = frEnv.get(sampleName);
        Rcpp::S4 fr = Rcpp::clone(frObj);

          //get local channel names
          Rcpp::StringVector colnames = x.slot("colnames");

          Rcpp::StringVector ch_selected;
         /*
          * subset by j if applicable
          */
         int j_type = j_obj.sexp_type();
         //creating j index used for subsetting colnames and pdata
         Rcpp::IntegerVector j_indx;

         if(j_type == STRSXP)//when character vector
         {
             ch_selected = Rcpp::StringVector(j_obj.get__());
             unsigned nCol = ch_selected.size();
             j_indx = Rcpp::IntegerVector(nCol);
             //match ch_selected to colnames
            for(unsigned i = 0 ; i < nCol; i ++)
            {
                const Rcpp::internal::string_proxy<STRSXP> &thisCh = ch_selected(i);
                Rcpp::StringVector::iterator match_id = std::find(colnames.begin(), colnames.end(), thisCh);
                if(match_id == colnames.end()){
                    std::string strCh = Rcpp::as<std::string>(thisCh);
                    Rcpp::stop("j subscript out of bounds: " + strCh);
                }else
                {
                    j_indx(i) = match_id - colnames.begin();
                }
            }
         }
         else if(j_type == NILSXP)//j is set to NULL in R when not supplied
         {
             ch_selected = colnames;
         }
         else if(j_type == LGLSXP)
         {
             Rcpp::LogicalVector j_val(j_obj.get__());
             ch_selected = colnames[j_val];
             #to convert numeric indices to integer
         }
         else if(j_type == INTSXP)
         {
             Rcpp::IntegerVector j_val(j_obj.get__());
             j_indx = j_val - 1; //convert to 0-based index
             ch_selected = colnames[j_indx];
         }
         else if(j_type == REALSXP)
         {
             Rcpp::NumericVector j_val(j_obj.get__());
             #to convert numeric indices to integer
         }
         else
             Rcpp::stop("unsupported j expression!");
        /*
         * subset annotationDataFrame (a data frame)
         * 
         */
         if(j_type != NILSXP)
         {
            Rcpp::S4 pheno = fr.slot("parameters");
            Rcpp::DataFrame pData = pheno.slot("data");

            Rcpp::CharacterVector pd_name = pData["name"];
            Rcpp::CharacterVector pd_desc = pData["desc"];
            Rcpp::NumericVector pd_range = pData["range"];
            Rcpp::NumericVector pd_minRange = pData["minRange"];
            Rcpp::NumericVector pd_maxRange = pData["maxRange"];

            Rcpp::DataFrame plist = Rcpp::DataFrame::create(Rcpp::Named("name") = pd_name[j_indx]
                                                        ,Rcpp::Named("desc") = pd_desc[j_indx]
                                                        ,Rcpp::Named("range") = pd_range[j_indx]
                                                        ,Rcpp::Named("minRange") = pd_minRange[j_indx]
                                                        ,Rcpp::Named("maxRange") = pd_maxRange[j_indx]
                                                        );
            pheno.slot("data") = plist;
         }

j中的R索引通常允许不同类型的输入（character，logical或numeric）。我想知道是否存在相同类型的polymorphic机制（可能通过抽象向量指针/引用），以便[-subsetting上的冗余代码（仅由于不同类型的Rcpp :: ** Vector）可以避免以后data.frame。

Answer 1

我们通常主张将逻辑分为调度步骤和模板化函数步骤。因此，您应该能够使用以下内容解决问题：

#include <Rcpp.h>
using namespace Rcpp;

template <typename T>
SEXP readFrame(Rcpp::S4 x, std::string sampleName, T const& j, bool useExpr) { 
    // use the typed 'j' expression
}

// [[Rcpp::export(subset)]]
SEXP readFrame_dispatch(Rcpp::S4 x, std::string sampleName, SEXP j, bool useExpr) 
    switch (TYPEOF(j)) {
    case INTSXP: return readFrame<IntegerVector>(x, sampleName, j, useExpr);
    case REALSXP: return readFrame<NumericVector>(x, sampleName, j, useExpr);
    case STRSXP: return readFrame<CharacterVector>(x, sampleName, j, useExpr);
    case LGLSXP: return readFrame<LogicalVector>(x, sampleName, j, useExpr);
    default: stop("Unsupported SEXP type");
    }
    return R_NilValue;
}

Rcpp中的一个设计目标是出于速度原因尽可能避免运行时多态性 - 几乎所有多态都是静态完成的，并且运行时查找理想情况下应该只发生一次（除非偶尔出现我们被强制执行的时间）一些例程回叫R。）

调度代码有点丑陋和机械，但允许这种风格＆＃39;编程。如果＆＃39; dispatch＆＃39;那么代码将变得更具可读性。与“实施”分开同样，你可以在一个地方隐藏调度丑陋。

我想知道是否有一些宏魔法可以减少该表单的调度代码中的代码重复，但是......

Rcpp向量子集中的多态性

1 个答案: