看似PROTECTed对表的垃圾收集

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))。因为输出的长度是可变的，所以我使用一个配对列表(因为它是可增长的)，然后在末尾调用Rf_PairToVectorList()，使其成为一个常规列表。

我收到一个奇怪的垃圾收集错误。我的PROTECTed对列表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上有一个最小的可复制包，并且我使用GitHub操作运行了R CMD CHECK，其结果在https://github.com/rorynolan/testpkg/runs/1076595757?check_suite_focus=true上。这就是我发现是哪一行导致错误的地方。

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

我应该补充说，这个函数有时如预期的那样工作，有时会出现这个问题。这使人们怀疑这是一个垃圾收集问题。

Answer 1

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

第5行中的nc.

• Then，

1. 分配是12使用nr作为限制
2. .比第39行的nc大。

。

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)); // !!!
    ...
  }
}

Answer 2

您可以使用标准列表( VECSXP)，而不是尝试增长然后转换成对列表。你不需要增加一个列表的原因是，通过矩阵快速的一行循环会告诉你你的数字中有多少“空白”，因此你需要在列表中预先分配多少向量。这使得事情变得简单多了，而且可能也更有效率了。

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

用于从两个INTSXPs创建长度-2 ints的函数如下所示：

#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 3

这个真的很复杂。您做了很大的努力来创建这个难以跟踪的错误的可复制示例。

我试着解决你的问题，不幸的是我失败了。尽管如此，我还是会和你们分享我的发现，因为到目前为止还没有其他人回答(也许这有帮助)。

我安装了您的testpkg并将fullocate函数添加到命名空间中。将其作为导出的函数。

这样，我就能够build包，用testpkg::fullocate(int_mat)运行函数，并通过devtools::check()运行它。

有趣的是，如果我通过check()运行它，那么每次运行测试时都会失败。

运行‘testthat.R.R’：

 ── Test failures ───────────────────────── testthat ────

 library(testthat)
 library(testpkg)
 
 test_check("testpkg")
row_num: 2
[[1]]
.Primitive("for")

here1row_num: 3
[[1]]
.Primitive("for")

[[2]]
[[2]][[1]]

 *** caught segfault ***
address 0xa00000007, cause 'memory not mapped'

Traceback:
 1: fullocate(int_mat)
 2: eval_bare(expr, quo_get_env(quo))
 3: quasi_label(enquo(object), label, arg = "object")
 4: expect_equal(fullocate(int_mat), list(c(5L, 6L), c(7L, 10L),     c(11L, 19L), c(20L, 30L)))
 5: eval(code, test_env)
 6: eval(code, test_env)
 7: withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error)
 8: doTryCatch(return(expr), name, parentenv, handler)

就像你得到的一样，一些记忆问题：

地址0xa00000007，导致“内存未映射”

当我只运行这个函数时，有趣的是，我可以成功地运行它几次，直到它出现错误为止。不管成功与否似乎都是随机的。有时，整个R会话会崩溃。

下面是在不使用check()的情况下运行它时所遇到的错误。

Fehler in h(simpleError(msg，call))：Fehler bei der Auswertung 'object‘derür Funktion 'show'：lazy_duplicate中的nicht implementierter (27)

错误:没有更多的错误处理程序可用(递归错误？)；调用'abort‘重启这里是我得到的错误消息：

Fehler in h(simpleError(msg, call)) : 
  Fehler bei der Auswertung des Argumentes 'object' bei der Methodenauswahl für Funktion 'show': nicht implementierter Typ (27) in 'eval'
Fehler während wrapup: nicht implementierter Typ (27) in 'lazy_duplicate'

Error: no more error handlers available (recursive errors?); invoking 'abort' restart

不会说太多..。

实际上，我有一些想法，为什么它可能会失败基于编写R扩展手册。有一个关于C垃圾收集问题的特殊部分。(https://cran.r-project.org/doc/manuals/r-release/R-exts.html#Garbage-Collection)如果你还没读过，这绝对值得一看。

一些有趣的事情要检查：

1. 注意到它是受保护的对象，而不是指针变量。如果您在某个时候调用了PROTECT(p)，那么从那时起p就会受到保护，这是一个常见的错误，但是当一个新对象被分配给p.

时，情况就不是这样了。

在某些情况下，

1. 需要更好地跟踪是否真的需要保护。尤其要注意生成大量对象的情况。指针保护堆栈有固定的大小(默认为10,000)，并且可能会满。

不应该是第二种情况，因为测试示例很小;)从事实来看，问题发生得如此随意，我(和您一样)会猜测一些需要保护的东西实际上没有得到保护。

我不太确定代码的意义，您指出这是导致失败的原因。但是，如果Rf_PrintValue(prlst);始终是发生错误的关键--它可能是一个指示符，可以更仔细地检查prlst和里面的内容。

正如我说的--最后我无法修复它--但我也没有花太多时间在它上。