//this function is for factor convert it maybe not safe
//because PooledDataArray.refs is Uint32 or bigger
//but in pratice it should be ok
static SEXP Julia_R_MD_INT(jl_value_t *Var)
{
SEXP ans = R_NilValue;
jl_value_t *val;
if (((jl_array_t *)Var)->ptrarray)
val = jl_cellref(Var, 0);
else
val = jl_arrayref((jl_array_t *)Var, 0);
int len = jl_array_len(Var);
if (len == 0) return ans;
if (jl_is_int32(val))
{
int32_t *p = (int32_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_int64(val))
{
int64_t *p = (int64_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_int8(val))
{
int8_t *p = (int8_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_int16(val))
{
int16_t *p = (int16_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_uint8(val))
{
uint8_t *p = (uint8_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_uint16(val))
{
uint16_t *p = (uint16_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_uint32(val))
{
uint32_t *p = (uint32_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_uint64(val))
{
uint64_t *p = (uint64_t *) jl_array_data(Var);
jlint_to_r_md;
}
return ans;
}
static SEXP Julia_R_MD_NA(jl_value_t *Var)
{
SEXP ans = R_NilValue;
char *strData = "Varname0tmp.data";
char *strNA = "bitunpack(Varname0tmp.na)";
jl_set_global(jl_main_module, jl_symbol("Varname0tmp"), (jl_value_t *)Var);
jl_value_t *retData = jl_eval_string(strData);
jl_value_t *retNA = jl_eval_string(strNA);
jl_value_t *val;
if (((jl_array_t *)retData)->ptrarray)
val = jl_cellref(retData, 0);
else
val = jl_arrayref((jl_array_t *)retData, 0);
int len = jl_array_len(retData);
if (len == 0)
return ans;
int ndims = jl_array_ndims(retData);
SEXP dims;
PROTECT(dims = allocVector(INTSXP, ndims));
for (size_t i = 0; i < ndims; i++)
INTEGER(dims)[i] = jl_array_dim(retData, i);
UNPROTECT(1);
//bool array
char *pNA = (char *) jl_array_data(retNA);
if (jl_is_bool(val))
{
char *p = (char *) jl_array_data(retData);
PROTECT(ans = allocArray(LGLSXP, dims));
for (size_t i = 0; i < len; i++)
if (pNA[i])
LOGICAL(ans)[i] = NA_LOGICAL;
else
LOGICAL(ans)[i] = p[i];
UNPROTECT(1);
}
else if (jl_is_int32(val))
{
int32_t *p = (int32_t *) jl_array_data(retData);
jlint_to_r_na;
}
//int64
else if (jl_is_int64(val))
{
int64_t *p = (int64_t *) jl_array_data(retData);
jlbiggerint_to_r_na;
}
//more integer type
else if (jl_is_int8(val))
{
int8_t *p = (int8_t *) jl_array_data(retData);
jlint_to_r_na;
}
else if (jl_is_int16(val))
{
int16_t *p = (int16_t *) jl_array_data(retData);
jlint_to_r_na;
}
else if (jl_is_uint8(val))
{
uint8_t *p = (uint8_t *) jl_array_data(retData);
jlint_to_r_na;
}
else if (jl_is_uint16(val))
{
uint16_t *p = (uint16_t *) jl_array_data(retData);
jlint_to_r_na;
}
else if (jl_is_uint32(val))
{
uint32_t *p = (uint32_t *) jl_array_data(retData);
jlbiggerint_to_r_na;
}
else if (jl_is_uint64(val))
{
uint64_t *p = (uint64_t *) jl_array_data(retData);
jlbiggerint_to_r_na;
}
//double
else if (jl_is_float64(val))
{
double *p = (double *) jl_array_data(retData);
jlfloat_to_r_na;
}
else if (jl_is_float32(val))
{
float *p = (float *) jl_array_data(retData);
jlfloat_to_r_na;
}
//convert string array to STRSXP
else if (jl_is_utf8_string(val))
{
PROTECT(ans = allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
if (pNA[i])
SET_STRING_ELT(ans, i, NA_STRING);
else
SET_STRING_ELT(ans, i, mkCharCE(jl_string_data(jl_cellref(retData, i)), CE_UTF8));
UNPROTECT(1);
}
else if (jl_is_ascii_string(val))
{
PROTECT(ans = allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
if (pNA[i])
SET_STRING_ELT(ans, i, NA_STRING);
else
SET_STRING_ELT(ans, i, mkChar(jl_string_data(jl_cellref(retData, i))));
UNPROTECT(1);
}
return ans;
}
static SEXP Julia_R_MD(jl_value_t *Var)
{
SEXP ans = R_NilValue;
jl_value_t *val;
if (((jl_array_t *)Var)->ptrarray)
val = jl_cellref(Var, 0);
else
val = jl_arrayref((jl_array_t *)Var, 0);
//get Julia dims and set R array Dims
int len = jl_array_len(Var);
if (len == 0)
return ans;
int ndims = jl_array_ndims(Var);
SEXP dims;
PROTECT(dims = allocVector(INTSXP, ndims));
for (size_t i = 0; i < ndims; i++)
{
INTEGER(dims)[i] = jl_array_dim(Var, i);
}
UNPROTECT(1);
if (jl_is_bool(val))
{
char *p = (char *) jl_array_data(Var);
PROTECT(ans = allocArray(LGLSXP, dims));
for (size_t i = 0; i < len; i++)
LOGICAL(ans)[i] = p[i];
UNPROTECT(1);
}
else if (jl_is_int32(val))
{
int32_t *p = (int32_t *) jl_array_data(Var);
jlint_to_r;
}
//int64
else if (jl_is_int64(val))
{
int64_t *p = (int64_t *) jl_array_data(Var);
jlbiggerint_to_r;
}
//more integer type
else if (jl_is_int8(val))
{
int8_t *p = (int8_t *) jl_array_data(Var);
jlint_to_r;
}
else if (jl_is_int16(val))
{
int16_t *p = (int16_t *) jl_array_data(Var);
jlint_to_r;
}
else if (jl_is_uint8(val))
{
uint8_t *p = (uint8_t *) jl_array_data(Var);
jlint_to_r;
}
else if (jl_is_uint16(val))
{
uint16_t *p = (uint16_t *) jl_array_data(Var);
jlint_to_r;
}
else if (jl_is_uint32(val))
{
uint32_t *p = (uint32_t *) jl_array_data(Var);
jlbiggerint_to_r;
}
else if (jl_is_uint64(val))
{
uint64_t *p = (uint64_t *) jl_array_data(Var);
jlbiggerint_to_r;
}
//double
else if (jl_is_float64(val))
{
double *p = (double *) jl_array_data(Var);
jlfloat_to_r;
}
else if (jl_is_float32(val))
{
float *p = (float *) jl_array_data(Var);
jlfloat_to_r;
}
//convert string array to STRSXP ,but not sure it is corret?
else if (jl_is_utf8_string(val))
{
PROTECT(ans = allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
SET_STRING_ELT(ans, i, mkCharCE(jl_string_data(jl_cellref(Var, i)), CE_UTF8));
UNPROTECT(1);
}
else if (jl_is_ascii_string(val))
{
PROTECT(ans = allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
SET_STRING_ELT(ans, i, mkChar(jl_string_data(jl_cellref(Var, i))));
UNPROTECT(1);
}
return ans;
}
static SEXP Julia_R_Scalar(jl_value_t *Var)
{
SEXP ans = R_NilValue;
double tmpfloat;
//most common type is here
if (jl_is_int32(Var))
{
PROTECT(ans = ScalarInteger(jl_unbox_int32(Var)));
UNPROTECT(1);
}
else if (jl_is_int64(Var))
{
tmpfloat=(double)jl_unbox_int64(Var);
if (inInt32Range(tmpfloat))
PROTECT(ans = ScalarInteger((int32_t)jl_unbox_int64(Var)));
else
PROTECT(ans = ScalarReal(tmpfloat));
UNPROTECT(1);
}
//more integer type
if (jl_is_uint32(Var))
{
tmpfloat=(double)jl_unbox_uint32(Var);
if (inInt32Range(tmpfloat))
PROTECT(ans = ScalarInteger((int32_t)jl_unbox_uint32(Var)));
else
PROTECT(ans = ScalarReal(tmpfloat));
UNPROTECT(1);
}
else if (jl_is_uint64(Var))
{
tmpfloat=(double)jl_unbox_int64(Var);
if (inInt32Range(tmpfloat))
PROTECT(ans = ScalarInteger((int32_t)jl_unbox_uint64(Var)));
else
PROTECT(ans = ScalarReal(tmpfloat));
UNPROTECT(1);
}
else if (jl_is_float64(Var))
{
PROTECT(ans = ScalarReal(jl_unbox_float64(Var)));
UNPROTECT(1);
}
else if (jl_is_float32(Var))
{
PROTECT(ans = ScalarReal(jl_unbox_float32(Var)));
UNPROTECT(1);
}
else if (jl_is_bool(Var))
{
PROTECT(ans = ScalarLogical(jl_unbox_bool(Var)));
UNPROTECT(1);
}
else if (jl_is_int8(Var))
{
PROTECT(ans = ScalarInteger(jl_unbox_int8(Var)));
UNPROTECT(1);
}
else if (jl_is_uint8(Var))
{
PROTECT(ans = ScalarInteger(jl_unbox_uint8(Var)));
UNPROTECT(1);
}
else if (jl_is_int16(Var))
{
PROTECT(ans = ScalarInteger(jl_unbox_int16(Var)));
UNPROTECT(1);
}
else if (jl_is_uint16(Var))
{
PROTECT(ans = ScalarInteger(jl_unbox_uint16(Var)));
UNPROTECT(1);
}
else if (jl_is_utf8_string(Var))
{
PROTECT(ans = allocVector(STRSXP, 1));
SET_STRING_ELT(ans, 0, mkCharCE(jl_string_data(Var), CE_UTF8));
UNPROTECT(1);
}
else if (jl_is_ascii_string(Var))
{
PROTECT(ans = ScalarString(mkChar(jl_string_data(Var))));
UNPROTECT(1);
}
return ans;
}
// adapted from https://github.com/armgong/RJulia/blob/master/src/R_Julia.c
SEXP jr_scalar(jl_value_t *tt)
{
SEXP ans = R_NilValue;
double z;
// float64, int64, int32 are most common, so put them in the front
if (jl_is_float64(tt))
{
PROTECT(ans = Rf_ScalarReal(jl_unbox_float64(tt)));
UNPROTECT(1);
}
else if (jl_is_int32(tt))
{
PROTECT(ans = Rf_ScalarInteger(jl_unbox_int32(tt)));
UNPROTECT(1);
}
else if (jl_is_int64(tt))
{
z = (double)jl_unbox_int64(tt);
if (in_int32_range(z))
PROTECT(ans = Rf_ScalarInteger((int32_t)jl_unbox_int64(tt)));
else
PROTECT(ans = Rf_ScalarReal(z));
UNPROTECT(1);
}
else if (jl_is_bool(tt))
{
PROTECT(ans = Rf_ScalarLogical(jl_unbox_bool(tt)));
UNPROTECT(1);
}
else if (jl_is_int8(tt))
{
PROTECT(ans = Rf_ScalarInteger(jl_unbox_int8(tt)));
UNPROTECT(1);
}
else if (jl_is_uint8(tt))
{
PROTECT(ans = Rf_ScalarInteger(jl_unbox_uint8(tt)));
UNPROTECT(1);
}
else if (jl_is_int16(tt))
{
PROTECT(ans = Rf_ScalarInteger(jl_unbox_int16(tt)));
UNPROTECT(1);
}
else if (jl_is_uint16(tt))
{
PROTECT(ans = Rf_ScalarInteger(jl_unbox_uint16(tt)));
UNPROTECT(1);
}
else if (jl_is_uint32(tt))
{
z = (double)jl_unbox_uint32(tt);
if (in_int32_range(z))
PROTECT(ans = Rf_ScalarInteger((int32_t)jl_unbox_uint32(tt)));
else
PROTECT(ans = Rf_ScalarReal(z));
UNPROTECT(1);
}
else if (jl_is_uint64(tt))
{
z = (double)jl_unbox_int64(tt);
if (in_int32_range(z))
PROTECT(ans = Rf_ScalarInteger((int32_t)jl_unbox_uint64(tt)));
else
PROTECT(ans = Rf_ScalarReal(z));
UNPROTECT(1);
}
else if (jl_is_float32(tt))
{
PROTECT(ans = Rf_ScalarReal(jl_unbox_float32(tt)));
UNPROTECT(1);
}
else if (jl_is_utf8_string(tt))
{
PROTECT(ans = Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(ans, 0, Rf_mkCharCE(jl_string_data(tt), CE_UTF8));
UNPROTECT(1);
}
else if (jl_is_ascii_string(tt))
{
PROTECT(ans = Rf_ScalarString(Rf_mkChar(jl_string_data(tt))));
UNPROTECT(1);
}
return ans;
}
template <> inline uint8_t unbox<uint8_t>(jl_value_t* val) { JULIACPP_ASSERT_NOMSG(jl_is_uint8(val)); return jl_unbox_uint8(val); }