Rcpp_DataFrame のバックアップ(No.2) - アールメカブ

アールメカブ


Rcpp_DataFrame のバックアップ(No.2)


Rの備忘録

前にも書いた気がするけど.

Rから受け取ったオブジェクトを C++ でデータフレームに返すコードだけど, Rdefines.h の場合だと以下のようになるけど,Rcpp だと,その下のようにまとまる.Namespace が厄介だけど,コードは読みやすくなって,確かに吉.

################### Rでの伝統的なインターフェイス (R.h) を使う (ちょっと余計な手順があるかもしれないけど)

すべて開くすべて閉じる
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 
 
 
 
-
|
|
|
|
|
|
|
|
|
|
-
!
|
|
|
|
|
-
!
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!
#include <R.h>
#include <Rdefines.h>
extern int utf8locale;
 
SEXP dfmake(SEXP x, SEXP y, SEXP z){
  int pc=0;
  SEXP df, varlabels, tmp, row_names;//DataTypes;
 
  const char* xx = CHAR(STRING_ELT(x, 0));
  const char* yy = CHAR(STRING_ELT(y, 0));
  const char* zz = CHAR(STRING_ELT(z, 0));
 
  PROTECT(df = allocVector(VECSXP, 2));  pc++;
 
    SET_VECTOR_ELT(df, 0, allocVector(STRSXP, 3));
 
  SET_STRING_ELT(VECTOR_ELT(df,0), 0, mkCharCE(xx, (utf8locale)?CE_UTF8:CE_NATIVE));
  SET_STRING_ELT(VECTOR_ELT(df,0), 1, mkCharCE(yy, (utf8locale)?CE_UTF8:CE_NATIVE));
  SET_STRING_ELT(VECTOR_ELT(df,0), 2, mkCharCE(zz, (utf8locale)?CE_UTF8:CE_NATIVE));
    
    SET_VECTOR_ELT(df, 1, allocVector(INTSXP, 3));
 
  INTEGER(VECTOR_ELT(df,1))[0] = 10;
  INTEGER(VECTOR_ELT(df,1))[1] = 20;
  INTEGER(VECTOR_ELT(df,1))[2] = 30;
 
  PROTECT(varlabels = allocVector(STRSXP, 2));  pc++;
  SET_STRING_ELT(varlabels, 0, mkCharCE("Name", (utf8locale)?CE_UTF8:CE_NATIVE));
  SET_STRING_ELT(varlabels, 1, mkCharCE("Age", (utf8locale)?CE_UTF8:CE_NATIVE));
    
  PROTECT(tmp = mkString("data.frame"));
  pc++;
 
  PROTECT(row_names = allocVector(STRSXP, 3));
  pc++;
  SET_STRING_ELT(row_names, 0, mkCharCE("1", (utf8locale)?CE_UTF8:CE_NATIVE));
  SET_STRING_ELT(row_names, 1, mkCharCE("2", (utf8locale)?CE_UTF8:CE_NATIVE));
  SET_STRING_ELT(row_names, 2, mkCharCE("3", (utf8locale)?CE_UTF8:CE_NATIVE));
        
  setAttrib(df, R_ClassSymbol, tmp);
  setAttrib(df, R_NamesSymbol, varlabels);
  setAttrib(df, R_RowNamesSymbol, row_names);
 
  UNPROTECT(pc);
  return(df);
 
}

###################

Rcpp.h を使ってデータフレームを返す

すべて開くすべて閉じる
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 
 
 
 
-
|
|
|
|
|
|
|
#include "Rcpp.h"
 
using namespace Rcpp;
 
RcppExport SEXP dfMake2 (SEXP x, SEXP y, SEXP z){
  CharacterVector cv = CharacterVector::create(as<std::string>(x),
                                               as<std::string>(y),
                                               as<std::string>(z));
  IntegerVector nv = IntegerVector::create(10,20,30);
  
  return DataFrame::create(Named("Name") =  cv,  Named ("Age") =  nv,
                           Named("stringsAsFactors") = false );