Exemplo n.º 1
0
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;
}
Exemplo n.º 2
0
/**
 * 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