11. ポインタの扱い

主に、Rのオブジェクトはポインタとして扱う。

11.1. POINTER系

  • LOGICAL_POINTER
  • INTEGER_POINTER
  • NUMERIC_POINTER
  • CHARACTER_POINTER
  • COMPLEX_POINTER
  • LIST_POINTER
  • RAW_POINTER

11.2. コード

#include <R.h>
#include <Rinternals.h>
#include <Rdefines.h>

SEXP oneplus(SEXP arg_p) {
    if(!IS_NUMERIC(arg_p)) {

        printf("Not numeric, argument must be numeric");

        return R_NilValue;
    }

    int len = length(arg_p);

    for(int i = 0; i < len; i++) {
        NUMERIC_POINTER(arg_p)[i]++;
    }

    return arg_p;
}
dyn.load("oneplus.so")

oneplus <- function(num) {
    .Call("oneplus", num)
}

oneplus(1:5)
# Not numeric, argument must be numericNULL

oneplus(c(1, 2, 3))
# [1] 2 3 4

oneplus("a")
# Not numeric, argument must be numericNULL

11.3. DATA系

  • LOGICAL_DATA
  • INTEGER_DATA
  • DOUBLE_DATA
  • NUMERIC_DATA
  • CHARACTER_DATA
  • COMPLEX_DATA
  • RECURSIVE_DATA
  • VECTOR_DATA

11.4. コード

#include <R.h>
#include <Rinternals.h>
#include <Rdefines.h>

SEXP oneplus_data(SEXP arg_p) {
    if(!IS_NUMERIC(arg_p)) {

        printf("Not numeric, argument must be numeric");

        return R_NilValue;
    }

    int len = length(arg_p);

    for(int i = 0; i < len; i++) {
        NUMERIC_DATA(arg_p)[i]++;
    }

    return arg_p;
}
dyn.load("oneplus_data.so")

oneplus_data <- function(num) {
    .Call("oneplus_data", num)
}

oneplus_data(1:5)
# Not numeric, argument must be numericNULL

oneplus_data(c(1, 2, 3))
# [1] 2 3 4

oneplus_data("a")
# Not numeric, argument must be numericNULL

11.5. VALUE系

  • LOGICAL_VALUE
  • INTEGER_VALUE
  • NUMERIC_VALUE
  • CHARACTER_VALUE
  • STRING_VALUE
  • LIST_VALUE
  • RAW_VALUE

実際には、 LIST_VALUERAW_VALUE は利用できず、異常系のみの実装。

11.6. コード

#include <R.h>
#include <Rinternals.h>
#include <Rdefines.h>

SEXP check_value(SEXP arg_p) {

    int len = length(arg_p);

    SEXP res;

    res = PROTECT(NEW_INTEGER(len));

    for(int i = 0; i < len; i++) {

        INTEGER_POINTER(res)[i] = LOGICAL_VALUE(arg_p);

    }

    UNPROTECT(1);

    return res;
}
dyn.load("check_value.so")

check_log <- function(vec) {

    .Call("check_value", vec)

}

check_log(T)
# [1] 1

check_log(F)
# [1] 0

check_log(1)
# [1] 1

check_log(0)
# [1] 0

check_log(4)
# [1] 1

check_log("a")
# [1] NA

check_log(c(T, F, T, F, F))
# [1] 1 1 1 1 1