int square(double a[],double b[])
{
// Init Julia
jl_init_with_image("/Users/fgans/julia/julia-4d1b751dda/lib/julia", "sys.ji");
JL_SET_STACK_BASE;
// Define Array Type for 1D Array
jl_value_t* array_type = jl_apply_array_type(jl_float64_type, 1);
// Connect C-Arrays to julia Arrays
jl_array_t *a_jl = jl_ptr_to_array_1d(array_type, a, 1, 0);
jl_array_t *b_jl = jl_ptr_to_array_1d(array_type, b, 1, 0);
// Load julia code
jl_eval_string("include(\"square.jl\")");
// Get function
jl_function_t *func = jl_get_function(jl_main_module, "square");
if (func==NULL) {
printf("Function not found!\n");
return -1;
}
// Apply function
jl_call2(func, (jl_value_t*)a_jl,(jl_value_t*)b_jl);
if (jl_exception_occurred()) printf("%s \n", jl_typeof_str(jl_exception_occurred()));
return 0;
}
SEXP jr_dict(jl_value_t *tt)
{
SEXP ans = R_NilValue;
SEXP rnames;
jl_function_t *str = jl_get_function(jl_base_module, "string");
jl_function_t *getindex = jl_get_function(jl_base_module, "getindex");
jl_array_t *keys = (jl_array_t *) jl_call1(
jl_get_function(jl_base_module, "collect"),
jl_call1(jl_get_function(jl_base_module, "keys"), tt)
);
size_t m = jl_array_len(keys);
PROTECT(rnames = Rf_allocVector(STRSXP, m));
PROTECT(ans = Rf_allocVector(VECSXP, m));
jl_value_t *key, *value;
for(size_t i=0; i<m; i++)
{
key = jl_arrayref(keys, i);
value = jl_call2(getindex, tt, key);
SET_VECTOR_ELT(ans, i, jr_cast(value));
key = jl_call1(str, key);
SET_STRING_ELT(rnames, i, Rf_mkChar(jl_string_data(key)));
}
Rf_setAttrib(ans, R_NamesSymbol, rnames);
UNPROTECT(2);
return ans;
}
SEXP jr_data_array(jl_value_t *tt) {
SEXP ans = R_NilValue;
jl_function_t *func = jl_get_function(jl_base_module, "getindex");
jl_value_t *u = jl_get_nth_field(tt, 0);
jl_value_t *v = jl_get_nth_field(tt, 1);
JL_GC_PUSH2(&u, &v);
size_t len = jl_array_len(u);
ans = jr_array(u);
int ty = TYPEOF(ans);
for(size_t i=0; i<len; i++){
if (jl_unbox_bool(jl_call2(func, v, jl_box_long(i+1)))){
switch(ty) {
case LGLSXP:
LOGICAL(ans)[i] = NA_LOGICAL;
break;
case INTSXP:
INTEGER(ans)[i] = NA_INTEGER;
break;
case REALSXP:
REAL(ans)[i] = NA_REAL;
break;
case STRSXP:
SET_STRING_ELT(ans, i, NA_STRING);
break;
default:
LOGICAL(ans)[i] = NA_LOGICAL;
}
}
}
JL_GC_POP();
return ans;
}
std::vector<SqwBase::t_var> SqwJl::GetVars() const
{
std::vector<SqwBase::t_var> vecVars;
if(!m_bOk)
{
tl::log_err("Julia interpreter has not initialised, cannot get variables.");
return vecVars;
}
jl_function_t *pNames = jl_get_function(jl_base_module, "names");
jl_function_t *pGetField = jl_get_function(jl_base_module, "getfield");
jl_function_t *pPrint = jl_get_function(jl_base_module, "string");
if(!pNames || !pGetField || !pPrint)
{
tl::log_err("Required Julia functions not available.");
return vecVars;
}
jl_array_t* pArrNames = (jl_array_t*)jl_call1(pNames, (jl_value_t*)jl_main_module);
if(!pArrNames)
return vecVars;
std::size_t iSyms = jl_array_len(pArrNames);
for(std::size_t iSym=0; iSym<iSyms; ++iSym)
{
jl_sym_t* pSym = (jl_sym_t*)jl_array_ptr_ref(pArrNames, iSym);
if(!pSym) continue;
// name
std::string strName = jl_symbol_name(pSym);
if(strName.length() == 0) continue;
// type
jl_value_t* pFld = jl_call2(pGetField, (jl_value_t*)jl_main_module, (jl_value_t*)pSym);
if(!pFld) continue;
std::string strType = jl_typeof_str(pFld);
if(strType.length() == 0) continue;
if(strType[0] == '#' || strType == "Module") continue; // filter funcs and mods
// value
jl_value_t* pFldPr = jl_call1(pPrint, pFld);
if(!pFldPr) continue;
std::string strValue = jl_string_ptr(pFldPr);
SqwBase::t_var var;
std::get<0>(var) = std::move(strName);
std::get<1>(var) = std::move(strType);
std::get<2>(var) = std::move(strValue);
vecVars.push_back(var);
}
return vecVars;
}
void juliaProblem::EucGrad(Variable *x, Vector *egf) const
{
// x->Print("cpp gf x");//---
jl_value_t* array_type = jl_apply_array_type(jl_float64_type, 1);
double *xptr = x->ObtainWritePartialData();
jl_array_t *arrx = jl_ptr_to_array_1d(array_type, xptr, x->Getlength(), 0);
jl_array_t *arrtmp = nullptr;
if(x->TempDataExist(("Tmp")))
{
const SharedSpace *Tmp = x->ObtainReadTempData("Tmp");
// Tmp->Print("cpp gf inTmp");//---
const double *tmpptr = Tmp->ObtainReadData();
arrtmp = jl_ptr_to_array_1d(array_type, const_cast<double *> (tmpptr), Tmp->Getlength(), 0);
} else
{
arrtmp = jl_ptr_to_array_1d(array_type, nullptr, 0, 0);
}
jl_value_t *retresult = jl_call2(jl_gf, (jl_value_t *) arrx, (jl_value_t *) arrtmp);
jl_array_t *jl_egf = (jl_array_t *) jl_get_nth_field(retresult, 0);
jl_array_t *outtmp = (jl_array_t *) jl_get_nth_field(retresult, 1);
if(jl_array_len(jl_egf) != egf->Getlength())
{
std::cout << "error: the size of the Euclidean gradient is not correct!" << std::endl;
exit(EXIT_FAILURE);
}
integer egflen = egf->Getlength();
double *egfptr = egf->ObtainWriteEntireData();
dcopy_(&egflen, (double*)jl_array_data(jl_egf), &GLOBAL::IONE, egfptr, &GLOBAL::IONE);
// egf->Print("cpp gf egf:");//--
integer outtmplen = jl_array_len(outtmp);
if(outtmplen != 0)
{
SharedSpace *sharedouttmp = new SharedSpace(1, outtmplen);
double *outtmpptr = sharedouttmp->ObtainWriteEntireData();
dcopy_(&outtmplen, (double*)jl_array_data(outtmp), &GLOBAL::IONE, outtmpptr, &GLOBAL::IONE);
x->RemoveFromTempData("Tmp");
x->AddToTempData("Tmp", sharedouttmp);
}
};
double juliaProblem::f(Variable *x) const
{
// x->Print("cpp f x");//---
jl_value_t* array_type = jl_apply_array_type(jl_float64_type, 1);
double *xptr = x->ObtainWritePartialData();
jl_array_t *arrx = jl_ptr_to_array_1d(array_type, xptr, x->Getlength(), 0);
jl_array_t *arrtmp = nullptr;
if(x->TempDataExist(("Tmp")))
{
const SharedSpace *Tmp = x->ObtainReadTempData("Tmp");
const double *tmpptr = Tmp->ObtainReadData();
arrtmp = jl_ptr_to_array_1d(array_type, const_cast<double *> (tmpptr), Tmp->Getlength(), 0);
} else
{
arrtmp = jl_ptr_to_array_1d(array_type, nullptr, 0, 0);
}
jl_value_t *retresult = jl_call2(jl_f, (jl_value_t *) arrx, (jl_value_t *) arrtmp);
jl_get_nth_field(retresult, 0);
jl_value_t *fx = jl_get_nth_field(retresult, 0);
jl_array_t *outtmp = (jl_array_t *) jl_get_nth_field(retresult, 1);
integer outtmplen = jl_array_len(outtmp);
SharedSpace *sharedouttmp = new SharedSpace(1, outtmplen);
double *outtmpptr = sharedouttmp->ObtainWriteEntireData();
dcopy_(&outtmplen, (double*)jl_array_data(outtmp), &GLOBAL::IONE, outtmpptr, &GLOBAL::IONE);
// sharedouttmp->Print("cpp f tmp:");//----
x->RemoveFromTempData("Tmp");
x->AddToTempData("Tmp", sharedouttmp);
if(jl_is_float64(fx))
{
double result = jl_unbox_float64(fx);
// std::cout << "cpp f fx:" << result << std::endl;//-----
return result;
}
std::cout << "Error: The objectve function must return a number of double precision!" << std::endl;
exit(EXIT_FAILURE);
};
