float64_t COctaveInterface::get_real()
{
const octave_value f=get_arg_increment();
if (!f.is_real_scalar())
SG_ERROR("Expected Scalar Float as argument %d\n", m_rhs_counter);
return f.double_value();
}
bool COctaveInterface::get_bool()
{
const octave_value b=get_arg_increment();
if (b.is_bool_scalar())
return b.bool_value();
else if (b.is_real_scalar())
return (b.double_value()!=0);
else
SG_ERROR("Expected Scalar Boolean as argument %d\n", m_rhs_counter);
return false;
}
int32_t COctaveInterface::get_int()
{
const octave_value i=get_arg_increment();
if (!i.is_real_scalar())
SG_ERROR("Expected Scalar Integer as argument %d\n", m_rhs_counter);
double s=i.double_value();
if (s-CMath::floor(s)!=0)
SG_ERROR("Expected Integer as argument %d\n", m_rhs_counter);
return int32_t(s);
}
/**
* Converts an Octave object into an R object.
*/
template <> SEXP Rcpp::wrap( const octave_value& val){
VERBOSE_LOG("wrap<%s>", val.type_name().c_str());
if( val.is_null_value() ){
VERBOSE_LOG("null_value");
return R_NilValue;
}else if (val.is_matrix_type()) {// matrix value: row vectors are converted into R vectors
// check if multidimensional array
if( val.ndims() > 2 ){
VERBOSE_LOG("(NDArray) -> Array");
return ::wrap(val.array_value());
}else if ( val.is_string() ){
VERBOSE_LOG("(CellStr) -> CharacterVector");
//const string_vector s(val.cellstr_value()); // works >= 3.4.3
const Cell& s = val.cellstr_value();
int n = s.length();
if( n == 0 )
return CharacterVector(val.string_value());
// character vector
SEXP res = wrap(s);
VERBOSE_LOG("[%i]\n", Rf_length(res));
return res;
}else if ( val.is_char_matrix() ){
VERBOSE_LOG("(charMatrix) -> CharacterVector");
charMatrix m = val.char_matrix_value();
int n = m.rows();
CharacterVector res(n);
for(int i=0; i<n; ++i)
res[i] = m.row_as_string(i);
return res;
}
else if ( val.is_bool_type() ){
VERBOSE_LOG("(boolMatrix) -> LogicalMatrix");
return wrapArray<LGLSXP>(val.bool_matrix_value());
}else if( val.is_int32_type() || val.is_int64_type() || val.is_int16_type() || val.is_integer_type() ){
return ::wrap(static_cast<oct_intArray>(val.int32_array_value()));
}else if( val.is_real_type() ){
return ::wrap(val.matrix_value());
}else{
std::ostringstream err;
err << " - Octave matrix type `" << val.type_name().c_str() << "` not supported.";
WRAP_ERROR(err.str().c_str());
}
return R_NilValue;
}
else if (val.is_string()) {// single character string
VERBOSE_LOG("(string)\n");
const std::string s(val.string_value());
return CharacterVector(s);
}else if (val.is_scalar_type()) {// single scalar value
if ( val.is_bool_scalar() ){
VERBOSE_LOG("(bool_value)\n");
return wrap(val.bool_value());
}
else if ( val.is_integer_type() ){
VERBOSE_LOG("(int_value)\n");
return wrap(val.int_value());
}else if( val.is_real_type() ){
VERBOSE_LOG("(double_value)\n");
return wrap(val.double_value());
}else{
std::ostringstream err;
err << " - Octave scalar type `" << val.type_name().c_str() << "` not supported.";
WRAP_ERROR(err.str().c_str());
}
return R_NilValue;
} else if( val.is_map() ){ // Maps are converted into lists
VERBOSE_LOG("(map) -> ");
OCTAVE_MAP m = val.map_value();
const string_vector& keys = m.keys();
int n = keys.length();
Rcpp::List res;
if (keys.length () == 0){
VERBOSE_LOG("List[0] (no names)\n");
return res;
}else{
VERBOSE_LOG("NamedList[%i]:\n", n);
int nempty = 0;
for(int i=0; i < n; ++i){
const string& k = keys[i];
VERBOSE_LOG("$'%s'\t: ", k.c_str());
if( k[0] == '\0' ){
if( ++nempty > 1 )
WRAP_ERROR("<NamedList> - More than one empty name in Octave map");
}
const Cell& cell = m.contents(k);
if( cell.length() == 0 ){
VERBOSE_LOG("empty\n");
res[k] = R_NilValue;
continue;
}
res[k] = ::wrap(cell);
}
return res;
}
} else if( val.is_cs_list() PRE_3_4_0(|| val.is_list()) ){
VERBOSE_LOG("(cs_list) => List\n");
return wrap<octave_value_list>(val.list_value());
} else if( val.is_cell() ){// Cell objects are used for character vectors