Ejemplo n.º 1
0
//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;
}
Ejemplo n.º 2
0
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;
}
Ejemplo n.º 3
0
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;
}
Ejemplo n.º 4
0
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;
}
Ejemplo n.º 5
0
// 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;
}
Ejemplo n.º 6
0
	template <> inline uint8_t unbox<uint8_t>(jl_value_t* val) { JULIACPP_ASSERT_NOMSG(jl_is_uint8(val)); return jl_unbox_uint8(val); }