cxxfunction std::transform を使う例

> src <- '
+     Rcpp::List input(data);
+     Rcpp::Function f(fun);
+     Rcpp::List output(input.size());
+     std::transform(input.begin(), input.end(), output.begin(), f);
+     output.names() = input.names();
+     return output;
+ '
> cpp_lapply <- cxxfunction(signature(data="list", fun="function"), src, plugin="Rcpp")
> (a <- as.data.frame(matrix(1:12, 3, 4)))
  V1 V2 V3 V4
1  1  4  7 10
2  2  5  8 11
3  3  6  9 12
> cpp_lapply(a, summary)
$V1
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
    1.0     1.5     2.0     2.0     2.5     3.0

$V2
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
    4.0     4.5     5.0     5.0     5.5     6.0

$V3
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
    7.0     7.5     8.0     8.0     8.5     9.0

$V4
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
   10.0    10.5    11.0    11.0    11.5    12.0

> cpp_lapply(a, min)
$V1
[1] 1

$V2
[1] 4

$V3
[1] 7

$V4
[1] 10

cxxfunction 関数を呼ぶ例

inc <- '
    int func2(int n) {
        return n*2;
    }
'
src <- '
    Rcpp::IntegerVector N(n);
    Rcpp::IntegerVector ANS(1);
    ANS = func2(N(0)); /* [ ] でも ( ) でもよい */
    return ANS;
'
func <- cxxfunction(signature(n = "numeric"), body = src, inc=inc, plugin="Rcpp")

func(5)

Rcpp におけるクラス

スカラー変数というのはない（長さ 1 のベクトル）
Integer*, Numeric*, Logical*, Character*
　　　　　　　* は，Vector, Matrix

他に，List など

> src <- '
+ Rcpp::NumericVector x(xs);
+ Rcpp::NumericVector y(ys);
+ return Rcpp::wrap(ifelse(x < y, x*x, -(y*y)));
+ '
> a <- cxxfunction(signature(xs="numeric", ys="numeric"), src, plugin="Rcpp")
> a(rnorm(10), rnorm(10))
 [1]  1.04121737  1.72515331  0.24451134 -0.51313099  0.00310971  0.10984876 -0.37575399  0.22136341  0.90569395 -0.02640077

Rcpp: でなくて，こんな風にも書けるようだ。

> func <- cxxfunction(signature(xs="numeric", ns="integer"),
+     'int n = as<int>(ns);
+     double x = as<double>(xs);
+     double res;
+     res = pow(x, n);
+     return wrap(res);
+     ',
+     plugin="Rcpp")
> func(8.2, 3)
[1] 551.368

cxxfunction 行列を引数とする関数の例

行列を引数とする関数の例

> library(inline)
> src <- '
+ Rcpp::NumericMatrix xcpp(x);
+ int nrows = xcpp.nrow();
+ int ncolumns = xcpp.ncol();
+ for (int i = 0; i < nrows; i++) {
+     for (int j = 0; j < ncolumns; j++) {
+         xcpp[nrows * j + i] *= 2;
+     }
+ }
+ return xcpp;
+ '
> doublematrix <- cxxfunction(signature(x = "numeric"), body = src, plugin="Rcpp")
> print(doublematrix(matrix(1:10, nrow = 2)))
     [,1] [,2] [,3] [,4] [,5]
[1,]    2    6   10   14   18
[2,]    4    8   12   16   20

> src1 <- '
+     Rcpp::NumericMatrix xbem(xbe);
+     int nrows = xbem.nrow();
+     Rcpp::NumericVector gv(g);
+     for (int i = 1; i < nrows; i++) {
+         xbem(i,_) = xbem(i-1,_) * gv[0] + xbem(i,_);
+     }
+     return xbem;
+ '
> funCPP1 <- cxxfunction(signature(xbe = "numeric", g="numeric"), body = src1, plugin="Rcpp")
> A <- matrix(1:12, 3, 4)
> funCPP1(A, 0.5)
     [,1] [,2]  [,3] [,4]
[1,] 1.00  4.0  7.00   10
[2,] 2.50  7.0 11.50   16
[3,] 4.25  9.5 14.75   20

> src <- '
+     Rcpp::NumericMatrix input(x);
+     int nc = input.ncol();
+     Rcpp::NumericMatrix output = clone<NumericMatrix>(input);
+     for (int i = 1; i < nc; i++) {
+         output.column(i) = output.column(i-1)+input.column(i);
+     }
+     return output;
+ '
> row.cumsum <- cxxfunction(signature(x="numeric"), src, plugin="Rcpp")
> (a <- matrix(1:12, 3, 4))
     [,1] [,2] [,3] [,4]
[1,]    1    4    7   10
[2,]    2    5    8   11
[3,]    3    6    9   12
> row.cumsum(a)
     [,1] [,2] [,3] [,4]
[1,]    1    5   12   22
[2,]    2    7   15   26
[3,]    3    9   18   30