11

I want to write an R function using R's C interface that takes a 2-column matrix of increasing, non-overlapping integer intervals and returns a list with those intervals plus some added intervals, such that there are no gaps. For example, it should take the matrix rbind(c(5L, 6L), c(7L, 10L), c(20L, 30L)) and return list(c(5L, 6L), c(7L, 10L), c(11L, 19L), c(20L, 30L)). Because the output is of variable length, I use a pairlist (because it is growable) and then I call Rf_PairToVectorList() at the end to make it into a regular list.

I'm getting a strange garbage collection error. My PROTECTed pairlist prlst gets garbage collected away and causes a memory leak error when I try to access it.

Here's my code.

#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;
}

As you can see, I have some diagnostic print statements in there. The offending line is line 40, which I have marked with a comment of // This is where the error occurs. I have a minimal reproducible package at https://github.com/rorynolan/testpkg and I have run R CMD CHECK with valgrind using GitHub actions, the results of which are at https://github.com/rorynolan/testpkg/runs/1076595757?check_suite_focus=true. That's where I found out which line is causing the error.

I really want to know what my mistake is.

I should add that this function works as expected sometimes, and then sometimes this issue appears. This lends weight to the suspicion that it's a garbage collection issue.

4
  • I juat dont like this: row_num = 2; while (row_num <= nr) { Sep 6, 2020 at 1:32
  • 3
    I get that you don't like the style but it doesn't explain the garbage collection issue.
    – Rory Nolan
    Sep 6, 2020 at 2:44
  • Just a wild guess: does PROTECT(Rf_list1(prlst0cdr)); really protects the whole list with all the elements that will be created later on? Try to remove all UNPROTECT calls (probably including those in C_int_mat_nth_row_nrnc and C_make_len2_int_vec) except for the last one, which should become then something like UNPROTECT(N)
    – x00
    Sep 10, 2020 at 7:54
  • @AllanCameron I tried this but that's not it. The thing is that the garbage collector is concerned with objects, not pointers. The objected pointed to by prlst_tail is PROTECTed so it's fine. Thanks for the good suggestion though!
    – Rory Nolan
    Sep 10, 2020 at 18:08

3 Answers 3

Reset to default

Trending sort

Trending sort is based off of the default sorting method — by highest score — but it boosts votes that have happened recently, helping to surface more up-to-date answers.

It falls back to sorting by highest score if no posts are trending.

8

Instead of trying to grow then convert a pairlist, you can use a standard list (a VECSXP). The reason why you don't need to grow a list is that a quick one-line loop through your matrix will tell you how many "gaps" you have in your numbers, and therefore how many vectors you need to pre-allocate in the list. This turns out to make things considerably simpler and probably a bit more efficient too.

The other changes I have made are to move to a single helper function, which simply assigns a length-2 integer vector from two ints, and to UNPROTECT en masse at the end of your C_fullocate function. This is simple to do, since we have only assigned one vector per element of the final list, plus the list itself.

The function for creating length-2 INTSXPs from two ints looks like this:

#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;
}

And your main function becomes:

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;
}

So in R we have

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

And we can do:

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

Of course, the whole thing can be done much more simply using a single function in Rcpp. Here's an example where you can just grow the list, making the code considerably simpler (if maybe a little less efficient).

#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;
}
1
  • 2
    Wow, Allan, extremely nice job! "The shame is that this would be almost trivial in Rcpp." Haha, I was thinking exactly the same while trying myself at Nolans problem. Sep 10, 2020 at 23:24
7
+100

Function C_int_mat_nth_row_nrnc is writing values beyond the allocated limits.

  1. Allocation in line 5 is of size nc.
  2. Then, line 12 uses nr as a limit
  3. ... which is larger than nc in line 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)); // !!!
    ...
  }
}
4

This one is really complicated. You made a great effort to create a reproducible example of this hard to track error.

I tried fixing your problem, unfortunately I failed. But nevertheless I'll try to share my findings with you, since nobody else answered so far (maybe it helps)

I installed your testpkg and additionally added the fullocate function to the namespace. To have it as an exported function.

This way I was able to build the package and run the function with testpkg::fullocate(int_mat) and to run it via devtools::check().

Interestingly if I run it via check() it fails everytime, when running your testthat test.

Running ‘testthat.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)

So pretty similar to what you got, some memory issue:

address 0xa00000007, cause 'memory not mapped'

When I just run the function, interestingly, I can run it several times successfully, until it gives an error. Seems kind of random if it succeeds or not. From time to time the complete R session crashes.

Here is the error I get when running it without check().

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 Here is the error messages I get:

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

Does not say too much...

I actually had some ideas why it might have failed based on the Writing R Extensions Manual. There is a special section about the C Garbage Collection issues. (https://cran.r-project.org/doc/manuals/r-release/R-exts.html#Garbage-Collection) This is definitely worth a look, if you have not read it yet.

Some interesting things to check:

  1. Notice that it is the object which is protected, not the pointer variable. It is a common mistake to believe that if you invoked PROTECT(p) at some point then p is protected from then on, but that is not true once a new object is assigned to p.

  2. In some cases it is necessary to keep better track of whether protection is really needed. Be particularly aware of situations where a large number of objects are generated. The pointer protection stack has a fixed size (default 10,000) and can become full.

Shouldn't be the second case, since the test example is quite small ;) From the fact, that the problem occurs so random, I (like you) would guess somethings what needs to be Protected isn't actually protected.

I wasn't so sure about the point of code, which you pointed out as the cause of the failure. But if Rf_PrintValue(prlst); really is always the point, where the error occurs - it might be an indicator, to closer check prlst and what is inside.

As I told - in the end I couldn't fix it - but I also did not spend too much time on it.

2
  • Really appreciate your effort! I have read "Writing R Extensions." In fact, my code relies on the statement from there that "Protecting an R object automatically protects all the R objects pointed to in the corresponding SEXPREC, for example all elements of a protected list are automatically protected." The Rf_PrintValue(prlst); is purely diagnostic. I could remove it but I get the same error then further down, the next time prlst is accessed.
    – Rory Nolan
    Sep 10, 2020 at 17:39
  • 1
    Some helpful insights here Steffen (+1). In then end, I couldn't get it to work without rewriting it completely. The shame is that this would be almost trivial in Rcpp. Sep 10, 2020 at 23:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.