RStudio 与具有可重现代码的 RCpp 一起崩溃

Question

@user3759195 写了一篇文章 https://stackoverflow.com/questions/24322356/rstudio-crashes-and-it-does-not-reproduce关于 RStudio 与 RCpp 崩溃的问题，但没有给出任何可重现的案例。 @KevinUshey 在评论中提到我们必须在代码中PROTECT wrap。

我冒昧地发布了用 RCpp 编写的 split.data.frame 函数的两个替代方案:

* 不会导致 RSTUDIO 崩溃的版本 *

//[[Rcpp::export]]
List splitDataFrameCpp(DataFrame x,NumericVector y) {
  int nRows=x.nrows();
  int nCols=x.size();

  std::map<double,vector<double> > z;
  for (int i=0;i<nCols;i++) {
    std::vector<double> tmp=Rcpp::as<std::vector<double> > (x[i]);
    for (int j=0;j<nRows;j++) {
      z[y[j]].push_back(tmp[j]);      
    }
  }

  std::vector<double> yunq=Rcpp::as<std::vector<double> > (sort_unique(y));
  std::map<double, DataFrame> z1;
  for (int i=0;i<int(yunq.size());i++) {
    NumericVector tmp1=wrap(z[yunq[i]]);   // *** DEFINING INSIDE LOOP ***
    tmp1.attr("dim")=Dimension(int(tmp1.size())/nCols,nCols);
    DataFrame tmp2(wrap(tmp1));   // *** DEFINING INSIDE LOOP ***
    tmp2.attr("names")=x.attr("names");
    z1[yunq[i]]=tmp2;
  }
  return wrap(z1);  
}

* 导致 RSTUDIO 崩溃的版本 *

//[[Rcpp::export]]
List splitDataFrameCpp(DataFrame x,NumericVector y) {
  int nRows=x.nrows();
  int nCols=x.size();

  std::map<double,vector<double> > z;
  for (int i=0;i<nCols;i++) {
    std::vector<double> tmp=Rcpp::as<std::vector<double> > (x[i]);
    for (int j=0;j<nRows;j++) {
      z[y[j]].push_back(tmp[j]);      
    }
  }

  std::vector<double> yunq=Rcpp::as<std::vector<double> > (sort_unique(y));
  std::map<double, DataFrame> z1;

  NumericVector tmp1;    // *** DEFINING OUTSIDE LOOP ***
  DataFrame tmp2;    // *** DEFINING OUTSIDE LOOP ***

  for (int i=0;i<int(yunq.size());i++) {
    tmp1=wrap(z[yunq[i]]);
    tmp1.attr("dim")=Dimension(int(tmp1.size())/nCols,nCols);
    tmp2=wrap(tmp1);
    tmp2.attr("names")=x.attr("names");
    z1[yunq[i]]=tmp2;
  }    
  return wrap(z1);      
}

这两种代码的主要区别在于，一种情况下 tmp1 和 tmp2 是在循环内定义的，而另一种情况是在循环外定义的。

1. 谁能解释为什么第二个循环会崩溃(以及可以更改哪些内容以免 RStudio 崩溃)？我仍然是 C++ 的新手，主要是通过查看 SO 或 RCpp 画廊网站上的示例来编写 RCpp - 所以想更多地了解这种行为。

2. 此外，作为附带好处，如果有人可以推荐更改以使代码更快，那就太好了。根据我使用的一些测试用例，目前不会崩溃的代码比 R 的 split.data.frame 函数快大约 2-3 倍。

测试用例示例:

> testDF
   V1 V2 V3 V4 V5 V6
1   1  5  4  1  3  2
2   2  1  5  4  1  3
3   2  2  1  5  4  1
4   3  2  2  1  5  4
5   1  3  2  2  1  5
6   4  1  3  2  2  1
7   1  5  4  1  3  2
8   2  1  5  4  1  3
9   2  2  1  5  4  1
10  3  2  2  1  5  4
11  1  3  2  2  1  5
12  4  1  3  2  2  1

> testSp<-c(1,1,1,2,2,2,3,4,4,3,3,5)

> split(testDF,testSp)     OR  > splitDataFrameCpp(testDF,testSp)     
$`1`
  V1 V2 V3 V4 V5 V6
1  1  5  4  1  3  2
2  2  1  5  4  1  3
3  2  2  1  5  4  1

$`2`
  V1 V2 V3 V4 V5 V6
4  3  2  2  1  5  4
5  1  3  2  2  1  5
6  4  1  3  2  2  1

$`3`
   V1 V2 V3 V4 V5 V6
7   1  5  4  1  3  2
10  3  2  2  1  5  4
11  1  3  2  2  1  5

$`4`
  V1 V2 V3 V4 V5 V6
8  2  1  5  4  1  3
9  2  2  1  5  4  1

$`5`
   V1 V2 V3 V4 V5 V6
12  4  1  3  2  2  1

此测试用例的微基准测试结果:

> microbenchmark(t1<-split(testDF,testSp),t2<-splitDataFrameCpp(testDF,testSp))
Unit: microseconds
                                   expr     min      lq   median       uq      max neval
             t1 <- split(testDF, test2) 343.181 365.562 372.8760 387.9430 1027.786   100
 t2 <- splitDataFrameCpp(testDF, test2) 177.881 190.315 200.5545 208.4545  870.093   100

* 编辑 *

添加了sessionInfo:

> sessionInfo()
R version 3.1.0 (2014-04-10)
Platform: x86_64-w64-mingw32/x64 (64-bit)

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252   
[3] LC_MONETARY=English_United States.1252 LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] microbenchmark_1.3-0

loaded via a namespace (and not attached):
[1] Rcpp_0.11.1 tools_3.1.0

此外，testDF 在 R 中创建为 numeric，而不是 integer。

Answer 1

对于它的值(value)，这里有一个完整的示例，您只需 sourceCpp() 即可。与凯文和罗曼所说的相似，它对我来说也没有爆炸。

#include <Rcpp.h>

using namespace Rcpp;
using namespace std;

//[[Rcpp::export]]
List splitDataFrameCppA(DataFrame x,NumericVector y) {
  int nRows=x.nrows();
  int nCols=x.size();

  std::map<double,vector<double> > z;
  for (int i=0;i<nCols;i++) {
    std::vector<double> tmp=Rcpp::as<std::vector<double> > (x[i]);
    for (int j=0;j<nRows;j++) {
      z[y[j]].push_back(tmp[j]);      
    }
  }

  std::vector<double> yunq=Rcpp::as<std::vector<double> > (sort_unique(y));
  std::map<double, DataFrame> z1;
  for (int i=0;i<int(yunq.size());i++) {
    NumericVector tmp1=wrap(z[yunq[i]]);   // *** DEFINING INSIDE LOOP ***
    tmp1.attr("dim")=Dimension(int(tmp1.size())/nCols,nCols);
    DataFrame tmp2(wrap(tmp1));   // *** DEFINING INSIDE LOOP ***
    tmp2.attr("names")=x.attr("names");
    z1[yunq[i]]=tmp2;
  }
  return wrap(z1);  
}


//[[Rcpp::export]]
List splitDataFrameCppB(DataFrame x,NumericVector y) {
  int nRows=x.nrows();
  int nCols=x.size();

  std::map<double,vector<double> > z;
  for (int i=0;i<nCols;i++) {
    std::vector<double> tmp=Rcpp::as<std::vector<double> > (x[i]);
    for (int j=0;j<nRows;j++) {
      z[y[j]].push_back(tmp[j]);      
    }
  }

  std::vector<double> yunq=Rcpp::as<std::vector<double> > (sort_unique(y));
  std::map<double, DataFrame> z1;

  NumericVector tmp1;    // *** DEFINING OUTSIDE LOOP ***
  DataFrame tmp2;    // *** DEFINING OUTSIDE LOOP ***

  for (int i=0;i<int(yunq.size());i++) {
    tmp1=wrap(z[yunq[i]]);
    tmp1.attr("dim")=Dimension(int(tmp1.size())/nCols,nCols);
    tmp2=wrap(tmp1);
    tmp2.attr("names")=x.attr("names");
    z1[yunq[i]]=tmp2;
  }    
  return wrap(z1);      
}


/*** R

testDF <- read.table(textConnection("
1  5  4  1  3  2
2  1  5  4  1  3
2  2  1  5  4  1
3  2  2  1  5  4
1  3  2  2  1  5
4  1  3  2  2  1
1  5  4  1  3  2
2  1  5  4  1  3
2  2  1  5  4  1
3  2  2  1  5  4
1  3  2  2  1  5
4  1  3  2  2  1
"))

testSp <- c(1,1,1,2,2,2,3,4,4,3,3,5)


str(splitDataFrameCppA(testDF, testSp))
str(splitDataFrameCppB(testDF, testSp))

library(microbenchmark)
microbenchmark(split(testDF,testSp),
               splitDataFrameCppA(testDF,testSp),
               splitDataFrameCppB(testDF,testSp))

*/

基准测试在您的两个版本之间大致相同:

R> library(microbenchmark)

R> microbenchmark(split(testDF,testSp),
+                splitDataFrameCppA(testDF,testSp),
+                splitDataFrameCppB(testDF,testSp))
Unit: microseconds
                               expr     min      lq  median      uq      max neval
              split(testDF, testSp) 687.271 724.748 745.287 791.574 2373.283   100
 splitDataFrameCppA(testDF, testSp) 380.781 393.161 406.686 421.469  491.803   100
 splitDataFrameCppB(testDF, testSp) 377.959 393.391 405.476 429.947 2052.193   100
R> 
R>