看似受保护的配对列表的垃圾收集

Question

我想使用 R 的 C 接口编写一个 R 函数，该函数采用递增的、非重叠的整数间隔的 2 列矩阵，并返回一个列表，其中包含这些间隔加上一些添加的间隔，这样就没有间隙。例如，它应该采用矩阵rbind(c(5L, 6L), c(7L, 10L), c(20L, 30L))并返回list(c(5L, 6L), c(7L, 10L), c(11L, 19L), c(20L, 30L))。因为输出是可变长度的，所以我使用了一个pairlist（因为它是可增长的），然后我Rf_PairToVectorList()在最后调用以使其成为一个常规列表。

我收到一个奇怪的垃圾收集错误。当我尝试访问它时，我的PROTECTed pairlistprlst被垃圾收集并导致内存泄漏错误。

这是我的代码。

#include <Rinternals.h>


SEXP C_int_mat_nth_row_nrnc(int *int_mat_int, int nr, int nc, int n) {
  SEXP out = PROTECT(Rf_allocVector(INTSXP, nc));
  int *out_int = INTEGER(out);
  if (n <= 0 | n > nr) {
    for (int i = 0; i != nc; ++i) {
      out_int[i] = NA_INTEGER;
    }
  } else {
    for (int i = 0; i != nr; ++i) {
      out_int[i] = int_mat_int[n - 1 + i * nr];
    }
  }
  UNPROTECT(1);
  return out;
}

SEXP C_make_len2_int_vec(int first, int second) {
  SEXP out = PROTECT(Rf_allocVector(INTSXP, 2));
  int *out_int = INTEGER(out);
  out_int[0] = first;
  out_int[1] = second;
  UNPROTECT(1);
  return out;
}

SEXP C_fullocate(SEXP int_mat) {
  int nr = Rf_nrows(int_mat), *int_mat_int = INTEGER(int_mat);
  int last, row_num;  // row_num will be 1-indexed
  SEXP prlst0cdr = PROTECT(C_int_mat_nth_row_nrnc(int_mat_int, nr, 2, 1));
  SEXP prlst = PROTECT(Rf_list1(prlst0cdr));
  SEXP prlst_tail = prlst;
  last = INTEGER(prlst0cdr)[1];
  row_num = 2;
  while (row_num <= nr) {
    Rprintf("row_num: %i\n", row_num);
    SEXP row = PROTECT(C_int_mat_nth_row_nrnc(int_mat_int, nr, 2, row_num));
    Rf_PrintValue(prlst);  // This is where the error occurs
    int *row_int = INTEGER(row);
    if (row_int[0] == last + 1) {
      Rprintf("here1");
      SEXP next = PROTECT(Rf_list1(row));
      prlst_tail = SETCDR(prlst_tail, next);
      last = row_int[1];
      UNPROTECT(1);
      ++row_num;
    } else {
      Rprintf("here2");
      SEXP next_car = PROTECT(C_make_len2_int_vec(last + 1, row_int[0] - 1));
      SEXP next = PROTECT(Rf_list1(next_car));
      prlst_tail = SETCDR(prlst_tail, next);
      last = row_int[0] - 1;
      UNPROTECT(2);
    }
    UNPROTECT(1);
  }
  SEXP out = PROTECT(Rf_PairToVectorList(prlst));
  UNPROTECT(3);
  return out;
}

如您所见，我在那里有一些诊断打印语句。有问题的行是第 40 行，我用// This is where the error occurs. 我在https://github.com/rorynolan/testpkg 上有一个最小的可重现包，我已经R CMD CHECK使用 GitHub 操作与 valgrind一起运行，其结果在https://github.com/rorynolan/testpkg/runs/1076595757？ check_suite_focus=true。这就是我发现哪一行导致错误的地方。

我真的很想知道我的错误是什么。

我应该补充一点，此功能有时会按预期工作，然后有时会出现此问题。这增加了对垃圾收集问题的怀疑。

Answer 1

您可以使用标准列表 (a VECSXP) ，而不是尝试增长然后转换成对列表。您不需要增加列表的原因是通过矩阵的快速单行循环将告诉您数字中有多少“差距”，因此您需要在列表。事实证明，这使事情变得相当简单，而且可能也更有效率。

我所做的其他更改是移动到单个辅助函数，它只是从两个ints 中分配一个长度为 2 的整数向量，并在函数的末尾UNPROTECT 集中在一起C_fullocate。这很容易做到，因为我们只为最终列表的每个元素分配了一个向量，加上列表本身。

INTSXP从两个ints创建 length-2 s的函数如下所示：

#include <Rinternals.h>

SEXP C_intsxp2(int first, int second) 
{
  SEXP out = PROTECT(Rf_allocVector(INTSXP, 2));
  INTEGER(out)[0] = first;
  INTEGER(out)[1] = second;
  UNPROTECT(1);
  return out;
}

你的主要功能变成：

SEXP C_fullocate(SEXP int_mat)
{
  int rows       = Rf_nrows(int_mat);
  int *values    = INTEGER(int_mat);
  int total_rows = rows;
  int rownum     = 1;

  // Counts how many elements we need in our list
  for(int i = 0; i < (rows - 1); ++i) {
    if(values[rows + i] != values[i + 1] - 1) ++total_rows;
  }

  // Creates the main list we will output at the end of the function
  SEXP list = PROTECT(Rf_allocVector(VECSXP, total_rows));

  // Creates and assigns first row
  SET_VECTOR_ELT(list, 0, PROTECT(C_intsxp2(values[0], values[rows])));

  for(int i = 1; i < rows; ++i) // Cycle through rest of the rows
  {
    if(values[rows + i - 1] != values[i] - 1) // Insert extra row if there's a gap
    {
      SEXP extra = PROTECT(C_intsxp2(values[rows + i - 1] + 1, values[i] - 1));
      SET_VECTOR_ELT(list, rownum++, extra);
    }
    // Copy next row of original matrix into our list
    SEXP next_row = PROTECT(C_intsxp2(values[i], values[i + rows]));
    SET_VECTOR_ELT(list, rownum++, next_row);
  }

  UNPROTECT(total_rows + 1);  // Unprotects all assigned rows plus main list

  return list;
}

所以在 R 我们有

test_mat <- matrix(as.integer(c(2, 10, 11, 20, 30, 40, 50, 60)),
                   ncol = 2, byrow = TRUE)

test_mat
#>      [,1] [,2]
#> [1,]    2   10
#> [2,]   11   20
#> [3,]   30   40
#> [4,]   50   60

我们可以这样做：

fullocate(test_mat)
#> [[1]]
#> [1]  2 10
#> 
#> [[2]]
#> [1] 11 20
#> 
#> [[3]]
#> [1] 21 29
#> 
#> [[4]]
#> [1] 30 40
#> 
#> [[5]]
#> [1] 41 49
#> 
#> [[6]]
#> [1] 50 60

当然，整个事情可以更简单地使用 Rcpp 中的单个函数来完成。这是一个示例，您可以在其中增加列表，从而使代码变得更加简单（如果效率可能会降低一些）。

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
List fullocate(IntegerMatrix m)
{
  List l = List::create(m(0, _));
  for(int i = 1; i < m.nrow(); ++i)
  {
    if(m(i, 0) != m(i - 1, 1) + 1){
      l.push_back(NumericVector::create(m(i - 1, 1) + 1, m(i, 0) - 1));
    }
    l.push_back(NumericVector::create(m(i, 0), m(i, 1)));
  }
  return l;
}

Answer 2

函数C_int_mat_nth_row_nrnc正在写入超出分配限制的值。

1. 第 5 行中的分配大小为nc。
2. 然后，线路12使用nr的限制
3. ...比nc第 39 行大。

SEXP C_int_mat_nth_row_nrnc(int *int_mat_int, int nr, int nc, int n) {
  SEXP out = PROTECT(Rf_allocVector(INTSXP, nc)); // allocating with `nc`
  ...
      for (int i = 0; i != nr; ++i) { // but `nr` is used as a limit
        out_int[i] = ...
      }
}
...
SEXP C_fullocate(SEXP int_mat) {
  ...
  row_num = 2;
  while (row_num <= nr) {
    ...
    SEXP row = PROTECT(C_int_mat_nth_row_nrnc(int_mat_int, nr, 2, row_num)); // !!!
    ...
  }
}