libr-bridge/SEXPWrap.mjs
"use strict";
import ref from "ref";
import Complex from "Complex";
import R from "./R";
import {SEXPTYPE, ComplexInR, cetype_t} from "./libR";
import { RFactor, RDataFrame, RArray, RBoolArray, RStrArray, RIntArray, RRealArray, RComplexArray } from "./RObject";
import debug_ from "debug";
const debug = debug_("libr-bridge:class SEXPWrap");
var sexpSize = void 0;
export default class SEXPWrap {
constructor(value){
if(value instanceof Buffer){
// This may be SEXP!
this.sexp = value;
}else{
this.__initializeWithValue(value);
}
}
toString(){
return "[SEXP]";
}
/**
* Initialize this instance with specified value.
* @private
*/
__initializeWithValue(value){
if(value === []){
debug("[]: " + value);
}
if(value instanceof RDataFrame){
/* it is ok. */
}else if(!Array.isArray(value)){
// not an array.
// convert to array and try again.
// (You can use Rf_mkString, Rf_ScalarReal, Rf_ScalarLogical if you don't want SEXPWrap)
return this.__initializeWithValue([value]);
}else if(value.length === 0){
this.sexp = R.R_NilValue;
}else if(!(value instanceof RArray)){
// Javascript normal array. (not RArray)
// Need to determine type of array.
if(typeof(value[0]) === "number" || value[0] === void 0){
value = RRealArray.of(...value);
}else if(typeof(value[0]) === "boolean"){
value = RBoolArray.of(...value);
}else if(typeof(value[0]) === "string"){
value = RStrArray.of(...value);
}else if(value[0] instanceof Complex){
value = RComplexArray.of(...value);
}else{
debug("Cannot recognize " + typeof(value[0]));
debug("value is: " + value);
throw new Error("Unknown type of array.");
}
}
if(value instanceof RFactor || value instanceof RIntArray){
// Factor is actually an 1-origin integers with attributes.
this.sexp = R.libR.Rf_allocVector(SEXPTYPE.INTSXP, value.length);
this.protect();
let p = ref.reinterpret(this.dataptr(), ref.types.int.size * value.length);
value.map((e, i) => {
ref.set(
p, ref.types.int.size * i,
e === void 0 ? R.R_NaInt : e, ref.types.int
);
});
if(value instanceof RFactor){
// add atribute
this.setAttribute("class", value.ordered ? ["factor", "ordered"] : "factor");
this.setAttribute("levels", value.levels);
}
this.unprotect();
}else if(value instanceof RRealArray){
// assume this is array of numbers (e.g. [1, 2, 3, ...])
this.sexp = R.libR.Rf_allocVector(SEXPTYPE.REALSXP, value.length);
this.protect();
let p = ref.reinterpret(this.dataptr(), ref.types.double.size * value.length);
value.map((e, i) => {
ref.set(p, ref.types.double.size * i, 1.0 * e /* convert to double */, ref.types.double);
});
// Find NA and set 1954. (sizeof(double) = sizeof(int) * 2)
p = ref.reinterpret(this.dataptr(), ref.types.int.size * 2 * value.length);
value.map((e, i) => {
if(e === void 0){ ref.set(p, ref.types.int.size * i * 2, 1954, ref.types.int); }
});
this.unprotect();
}else if(value instanceof RBoolArray){
// assume this is array of boolean (e.g. [false, true, true, ...])
// to handle NA, we use int instead of bool.
this.sexp = R.libR.Rf_allocVector(SEXPTYPE.LGLSXP, value.length);
this.protect();
let p = ref.reinterpret(this.dataptr(), ref.types.int.size * value.length);
value.map((e, i) => {
const value = e === void 0 ? R.R_NaInt : ( e ? 1 : 0 );
ref.set(p, ref.types.int.size * i, value, ref.types.int);
});
this.unprotect();
}else if(value instanceof RStrArray){
// assuming this is array of strings (e.g. ["abc", "def", ...])
this.sexp = R.libR.Rf_allocVector(SEXPTYPE.STRSXP, value.length);
this.protect();
value.map((e, i) => {
if(e !== void 0){
R.libR.SET_STRING_ELT(this.sexp, i, R.libR.Rf_mkCharCE(e, cetype_t.CE_UTF8));
}else{
R.libR.SET_STRING_ELT(this.sexp, i, R.R_NaString.sexp);
}
});
this.unprotect();
}else if(value instanceof RComplexArray){
this.sexp = R.libR.Rf_allocVector(SEXPTYPE.CPLXSXP, value.length);
this.protect();
let p = ref.reinterpret(this.dataptr(), ComplexInR.size * value.length);
value.map(
(e) => new ComplexInR({r: e.real, i: e.im})).map(
(e, i) => {
ref.set(p, ComplexInR.size * i, e, ComplexInR);
});
this.unprotect();
}else if(value instanceof RDataFrame){
let dfitem_sexp = [];
for (var [k, v] of value){
const v_sexp = new SEXPWrap(v);
v_sexp.protect();
v_sexp.argtag = k;
dfitem_sexp.push(v_sexp);
}
const false_sexp = new SEXPWrap(false);
false_sexp.protect();
false_sexp.argtag = "stringsAsFactors";
dfitem_sexp.push(false_sexp);
const r = new R();
const dataFrame = r.func_raw("data.frame");
const df_sexp = dataFrame(...dfitem_sexp);
df_sexp.protect();
for (const item in value){
df_sexp[item].unprotect();
}
false_sexp.unprotect();
this.sexp = df_sexp.sexp;
df_sexp.unprotect();
}else{
console.log("Cannot convert " + typeof(value) + " in JavaScript to R SEXP / " + value);
}
}
/** Protect this SEXP */
protect(){ R.libR.Rf_protect(this.sexp); }
/** Unprotect SEXPs */
static unprotect(depth=1){ R.libR.Rf_unprotect(depth); }
unprotect(depth=1){ R.libR.Rf_unprotect(depth); }
/** Preserve this SEXP. Please use protect() if you can. */
preserve(){ R.libR.R_PreserveObject(this.sexp); }
/** Release preserved SEXP. protect()ed SEXP should be released with unprotect() */
release(){ R.libR.R_ReleaseObject(this.sexp); }
/** Return true if this SEXP is List. */
isList(){ return R.libR.Rf_isList(this.sexp); }
/** Return true if this SEXP is Vector. Please note single scalar value in R is vector. */
isVector(){ return R.libR.Rf_isVector(this.sexp); }
/** Return the length of vector. */
length(){ return R.libR.Rf_length(this.sexp); }
/** Return true if this SEXP is null. */
isNull(){ return R.libR.Rf_isNull(this.sexp); }
isComplex(){ return R.libR.Rf_isComplex(this.sexp); }
isExpression(){ return R.libR.Rf_isExpression(this.sexp); }
isInteger(){ return R.libR.Rf_isInteger(this.sexp); }
isLogical(){ return R.libR.Rf_isLogical(this.sexp); }
isReal(){ return R.libR.Rf_isReal(this.sexp); }
isValidString(){ return R.libR.Rf_isValidString(this.sexp); }
isFactor(){ return R.libR.Rf_isFactor(this.sexp); }
isFrame(){ return R.libR.Rf_isFrame(this.sexp); }
isSymbol(){ return R.libR.Rf_isSymbol(this.sexp); }
isFunction(){ return R.libR.Rf_isFunction(this.sexp); }
dataptr(){ return R.libR.DATAPTR(this.sexp); }
getType(){ return R.libR.TYPEOF(this.sexp); }
asChar(){
if(this.sexp.address() == R.R_NaString.sexp.address()){ return void 0;}
if(this.sexp.address() == R.R_BlankString.sexp.address()){ return "";}
return R.libR.Rf_translateCharUTF8(R.libR.Rf_asChar(this.sexp)).slice();
}
/** Return sizeof(SEXP) in byte. */
get SEXPSize(){
console.log("!!!");
if(sexpSize === void 0){
const intSEXP = new SEXPWrap(0);
sexpSize = intSEXP.dataptr().address() - intSEXP.sexp.address();
}
return sexpSize;
}
get names(){
let names = new SEXPWrap(R.libR.Rf_getAttrib(this.sexp, R.R_NamesSymbol));
return names.isNull() ? undefined : names.getValue();
}
set names(newtag){
if (newtag === void 0) return;
R.libR.Rf_setAttrib(this.sexp, R.R_NamesSymbol, (new SEXPWrap(newtag)).sexp);
}
/** set attr of this variable. */
setAttribute(attrname, newattr){
const attrsymbol = R.libR.Rf_install(attrname);
R.libR.Rf_setAttrib(this.sexp, attrsymbol, (new SEXPWrap(newattr)).sexp);
}
/** get attr of this variable. */
getAttribute(attrname){
const attrvalue = new SEXPWrap(this._getAttribute_raw(attrname));
return attrvalue.getValue();
}
/** get attr SEXP of this variable. */
_getAttribute_raw(attrname){
const attrsymbol = R.libR.Rf_install(attrname);
return R.libR.Rf_getAttrib(this.sexp, attrsymbol);
}
getValue(){
if(this.sexp.address() == 0 || this.isNull()){
return null;
}
const len = this.length();
if(len == 0){
return [];
}if(this.isList()){
// TODO: support this
/*
let v = this.sexp;
return R.range(0, len).map( (e) => {
let a = R.libR.CAR(v);
v = R.libR.CDR(v);
return this._getValue_scalar(a);
});*/
console.log("LIST NOT SUPPORTED");
return undefined;
}else if(this.isFrame()){
// DataFrame is Vector of vectors.
const names = this.names;
const values = new Map();
R.range(0, len).map( (i) => {
const px = new SEXPWrap(R.libR.VECTOR_ELT(this.sexp, i));
values.set(names[i], px.getValue());
});
return values;
}else if(this.isVector()){ // be careful; is.vector(1) is even True
let itemtype;
let values = [];
if(this.isInteger() || this.isLogical() || this.isFactor()){
itemtype = ref.types.int;
const f = this.isLogical() ? (e) => !!e : (e) => e;
const p = ref.reinterpret(this.dataptr(), itemtype.size * len);
values = R.range(0, len).map( (i) => ref.get(p, itemtype.size * i, itemtype) )
.map( (e) => e == R.R_NaInt ? undefined : f(e));
if(this.isFactor()){
const levels = this.getAttribute("levels");
const class_ = this.getAttribute("class");
const isOrdered = Array.isArray(class_) && class_.indexOf("ordered") !== -1;
values = new RFactor(values.map((v) => levels[v - 1]), levels, isOrdered);
}
}else if(this.isReal()){
itemtype = ref.types.double;
const p = ref.reinterpret(this.dataptr(), itemtype.size * len);
values = R.range(0, len).map( (i) => ref.get(p, itemtype.size * i, itemtype) );
/* Discriminate NA from NaN (1954; the year Ross Ihaka was born) */
/* see main/arithmetic.c for detail. */
itemtype = ref.types.uint;
const q = ref.reinterpret(this.dataptr(), itemtype.size * len * 2);
R.range(0, len).map( (i) => {
if(isNaN(values[i])){
if(ref.get(q, itemtype.size * i * 2, itemtype) == 1954) values[i] = undefined;
}
});
}else if(this.isComplex()){
itemtype = ComplexInR;
const p = ref.reinterpret(this.dataptr(), itemtype.size * len);
values = R.range(0, len).map( (i) => ref.get(p, itemtype.size * i, itemtype))
.map( (e) => new Complex(e.r, e.i));
}else if(this.isValidString()){
values = R.range(0, len).map((i) => R.libR.STRING_ELT(this.sexp, i))
.map((e) => {
const s = new SEXPWrap(e);
return s.asChar();
});
}else if(this.isExpression()){
debug("getValue() for RExpression");
values = ["(R Expression)"];
}else{
values = ["Unsupported vector item!"];
}
return values.length == 1 ? values[0] : values;
}else if(this.isSymbol()){
return "[R Symbol]";
}else if(this.isFunction()){
return "[R Function]";
}else{
switch(this.getType()){
case 5:
debug("Promissed value: Get before evaluation");
return "[Promiss: Unevaluated value]";
default:
debug("Unknown type: " + this.getType());
return "[unknown type]";
}
}
}
_getValue_scalar(sexp){
// 'Number' includes complex, 'Vector' includes Array and Matrix
if(R.libR.Rf_isInteger(sexp)){
return R.libR.Rf_asInteger(sexp);
}else if(R.libR.Rf_isNumeric(sexp)){
return R.libR.Rf_asReal(sexp);
}else if(R.libR.Rf_isValidString(sexp)){
return R.libR.Rf_translateCharUTF8(R.libR.Rf_asChar(sexp)).slice();
}else{
return "SEXPWRAP: unknown SEXP Type";
}
}
}
/*
* vim: filetype=javascript
*/