8. NEW系

  • NEW_LOGICAL
  • NEW_INTEGER
  • NEW_NUMERIC
  • NEW_CHARACTER
  • NEW_COMPLEX
  • NEW_LIST
  • NEW_STRING
  • NEW_RAW

NEW系は、allocVector関数で書かれていることもある。 ポインタの宣言に使う。

引数は、数値で、宣言する要素数のこと。

8.1. コード

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

SEXP return_value() {
    SEXP str_p;

    PROTECT(str_p = NEW_CHARACTER(1));

    SET_STRING_ELT(str_p, 0, mkChar("Hello World"));

    UNPROTECT(1);
    return str_p;
}
dyn.load("return_value.so")

obj <- .Call("return_value")
cat(obj)

# Hello World

文字列の代入は、mkCharを利用する必要がある。

9. AS系

  • AS_LOGICAL
  • AS_INTEGER
  • AS_NUMERIC
  • AS_CHARACTER
  • AS_COMPLEX
  • AS_VECTOR
  • AS_LIST
  • AS_RAW

AS系は、coerceVector関数で書かれていることもある。 型変換を行う。

引数は、ポインタ

9.1. コード

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

SEXP coerce(SEXP arg) {
    SEXP res;

    res = AS_CHARACTER(arg);

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

coerce_chr <- function(chr) {

    RES <- .Call("coerce", chr)

    list(res = RES)
}

coerce_chr(1:5)

# $res
# [1] "1" "2" "3" "4" "5"

10. IS系

  • IS_LOGICAL
  • IS_INTEGER
  • IS_NUMERIC
  • IS_CHARACTER
  • IS_COMPLEX

IS系は、型をチェックする。

引数は、ポインタ

10.1. コード

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

SEXP check(SEXP arg_p) {
    int len = length(arg_p);

    if(len != 1) {
        printf("vec is not 1 element.\n");

        return R_NilValue;
    }

    SEXP res_is = PROTECT(NEW_LOGICAL(1));

    LOGICAL_POINTER(res_is)[0] = ( TYPEOF(arg_p) == LGLSXP );

    UNPROTECT(1);

    return res_is;

}
dyn.load("check.so")

check <- function(vec) {

    .Call("check", vec)
}

check(1:5)
# vec is not 1 element.
# NULL

check(1)
# [1] FALSE

check("a")
# [1] FALSE

check(T)
# [1] TRUE

今回は、IS系マクロの実態である TYPEOF(x) == SEXPTYPE を利用している。

もちろん、IS系も利用可能。

10.2. コード

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

SEXP check(SEXP arg_p) {
    int len = length(arg_p);

    if(len != 1) {
        printf("vec is not 1 element.\n");

        return R_NilValue;
    }

    SEXP res_is = PROTECT(NEW_LOGICAL(1));

    //LOGICAL_POINTER(res_is)[0] = ( TYPEOF(arg_p) == LGLSXP );
    LOGICAL_POINTER(res_is)[0] = IS_LOGICAL(arg_p);

    UNPROTECT(1);

    return res_is;

}
dyn.load("check_2.so")

check <- function(vec) {

    .Call("check", vec)
}

check(1:5)
# vec is not 1 element.
# NULL

check(1)
# [1] FALSE

check("a")
# [1] FALSE

check(T)
# [1] TRUE