r - 看似 protected 配对列表的垃圾收集

Question

我想使用 R 的 C 接口(interface)编写一个 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)) .因为输出是可变长度的，所以我使用了一个配对列表(因为它是可增长的)，然后我调用 Rf_PairToVectorList()最后使其成为常规列表。
我收到一个奇怪的垃圾收集错误。我的 PROTECT编辑配对列表 prlst当我尝试访问它时，会收集垃圾并导致内存泄漏错误。
这是我的代码。

#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 valgrind 使用 GitHub 操作，其结果位于 https://github.com/rorynolan/testpkg/runs/1076595757?check_suite_focus=true .那就是我发现哪一行导致错误的地方。
我真的很想知道我的错误是什么。
我应该补充一点，此功能有时会按预期工作，然后有时会出现此问题。这增加了对垃圾收集问题的怀疑。

Answer 1

您可以使用标准列表(VECSXP)，而不是尝试增长然后转换配对列表。您不需要增加列表的原因是，通过矩阵的快速单行循环会告诉您数字中有多少“间隙”，因此需要预先分配多少 vector 列表。事实证明，这使事情变得相当简单，并且可能也更有效率。
我所做的其他更改是移动到单个辅助函数，它只是从两个 int 中分配一个长度为 2 的整数 vector 。 s 和 UNPROTECT在您的 C_fullocate 末尾集体功能。这很容易做到，因为我们只为最终列表的每个元素分配了一个 vector ，加上列表本身。
创建length-2的函数INTSXP来自两个 int 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;
}