inline double width() const
{
if (is_bitmap())
return (*bitmap_data_)->width();
else if (is_vector())
return (*vector_data_)->bounding_box().width();
return 0;
}
inline double height() const
{
if (is_bitmap())
return (*bitmap_data_)->height();
else if (is_vector())
return (*vector_data_)->bounding_box().height();
return 0;
}
inline unsigned height() const
{
if (is_bitmap())
return (*bitmap_data_)->height();
else if (is_vector())
return static_cast<unsigned>((*vector_data_)->bounding_box().height());
return 0;
}
obj_t vector_ref(obj_t obj, size_t index)
{
CHECK_OBJ(obj);
CHECK(is_vector(obj), "must be vector", obj);
vector_obj_t *vec = (vector_obj_t *)obj;
CHECK(index < vec->v_size, "index out of range", obj, make_fixnum(index));
return *elem_addr(vec, index);
}
// Test for a single adjacent set of ideal register's size.
int is_bound(uint ireg) const {
if (is_vector(ireg)) {
if (is_bound_set(num_registers(ireg)))
return true;
} else if (is_bound1() || is_bound_pair()) {
return true;
}
return false;
}
static bool is_self_evaluating(obj_t *expr)
{
return (is_boolean(expr) ||
is_fixnum(expr) ||
is_character(expr) ||
is_string(expr) ||
is_vector(expr) ||
is_bytevector(expr));
}
var_t operator() (ti_vect_t tp) const {
if (!is_vector(v_)) return v_;
vector<var_t> vec = boost::get<vector<var_t> >(v_);
vector<var_t> result;
for (unsigned int i = 0; i < vec.size(); i++) {
result.push_back(apply_visitor(var_normalizer(vec[i]), tp.second));
}
return result;
}
bool operator() (ti_tuple_t tv) const {
if (!is_vector(v_)) return false;
vector<var_t> vec = boost::get<vector<var_t> >(v_);
if (vec.size() != tv.size()) return false;
for (unsigned int i = 0; i < tv.size(); i++) {
if (!apply_visitor(type_checker(vec[i]), tv[i])) return false;
}
return true;
}
bool operator() (ti_vect_t tp) const {
if (!is_vector(v_)) return false;
vector<var_t> vec = boost::get<vector<var_t> >(v_);
if (tp.first >= 0 && tp.first != static_cast<int>(vec.size())) return false;
for (unsigned int i = 0; i < vec.size(); i++) {
if (!apply_visitor(type_checker(vec[i]), tp.second)) return false;
}
return true;
}
void vector_set_nc(obj_t obj, size_t index, obj_t elem)
{
CHECK_OBJ(obj);
assert(is_vector(obj));
vector_obj_t *vec = (vector_obj_t *)obj;
assert(index < vec->v_size);
MUTATE(obj);
*elem_addr(vec, index) = elem;
}
void vector_set(obj_t obj, size_t index, obj_t elem)
{
CHECK_OBJ(obj);
CHECK(is_vector(obj), "must be vector", obj);
vector_obj_t *vec = (vector_obj_t *)obj;
//XXX CHECK(is_mutable(obj), "must be mutable", pair);
CHECK(index < vec->v_size, "index out of range", obj, make_fixnum(index));
MUTATE(obj);
*elem_addr(vec, index) = elem;
}
var_t operator() (ti_tuple_t tv) const {
if (!is_vector(v_)) return v_;
vector<var_t> vec = boost::get<vector<var_t> >(v_);
if (vec.size() != tv.size()) return v_;
vector<var_t> result;
for (unsigned int i = 0; i < tv.size(); i++) {
result.push_back(apply_visitor(var_normalizer(vec[i]), tv[i]));
}
return result;
}
static var_t normalize(tyinfo_map_t& tm, const string& key, const var_t& v) {
vector<var_t> vec = boost::get<vector<var_t> >(v);
type_t typ = tm[key];
// {{a,b,c}}や{{a}}, {{}}のケースか，primitive型で{a}などのケース
if (vec.size() == 1 && (is_prim_type(typ) || is_vector(vec[0]))) {
return apply_visitor(var_normalizer(vec[0]), typ);
}
// {a}, {a,b,c}, {{a},{b}}のケース
return apply_visitor(var_normalizer(v), typ);
}
//////////////////////////////////////////////////////
//self_evaluating
//number, boolean, string, character and vector object is self-evaluating.
//////////////////////////////////////////////////////
static cellpoint is_self_evaluating(cellpoint exp)
{
if (is_true(is_number(exp)) || is_true(is_boolean(exp)) ||
is_true(is_null(exp)) || is_true(is_string(exp)) ||
is_true(is_char(exp)) || is_true(is_vector(exp))){
reg = a_true;
}else {
reg = a_false;
}
return reg;
}
box2d<double> bounding_box() const
{
if (is_vector())
{
return (*vector_data_)->bounding_box();
}
if (is_bitmap())
{
double width = (*bitmap_data_)->width();
double height = (*bitmap_data_)->height();
return box2d<double>(0, 0, width, height);
}
return box2d<double>();
}
bool is_standard( const builtin_types& btc ){
if (btc == builtin_types::_sint32 ||
btc == builtin_types::_uint32 ||
btc == builtin_types::_sint64 ||
btc == builtin_types::_uint64 ||
btc == builtin_types::_float ||
btc == builtin_types::_double)
{
return true;
}
if ( is_vector(btc) || is_matrix(btc) ){
return is_standard(scalar_of(btc));
}
return false;
}
const std::string &Type::name() const {
auto i = names.find(type_id);
if(i!=names.end())
return i->second;
else if(is_vector()) {
std::stringstream s;
s << vector_of().name() << vector_size();
names.insert(std::pair<int, std::string>(type_id, s.str()));
return names[type_id];
} else if(is_pointer()) {
std::stringstream s;
s << "__global " << pointer_to().name() << " *";
names.insert(std::pair<int, std::string>(type_id, s.str()));
return names[type_id];
} else {
assert(!"Invalid type.");
}
}
builtin_types replace_scalar( builtin_types const& btc, builtin_types const& scalar_btc )
{
assert( is_scalar(scalar_btc) );
if( !is_scalar(scalar_btc) ) { return scalar_btc; }
if( is_vector(btc) )
{
return vector_of( scalar_btc, vector_size(btc) );
}
else if ( is_matrix(btc) )
{
return matrix_of( scalar_btc, vector_size(btc), vector_count(btc) );
}
else
{
return scalar_btc;
}
}
void scale_rows (
tensor& out,
const tensor& m,
const tensor& v
)
{
DLIB_CASSERT(have_same_dimensions(out,m));
DLIB_CASSERT(is_vector(v));
if (m.size() == 0 && v.size() == 0)
return;
DLIB_CASSERT(m.size() != 0);
DLIB_CASSERT(m.num_samples() == v.size());
#ifdef DLIB_USE_CUDA
cuda::scale_rows(out, m, v);
#else
out = scale_rows(mat(m), mat(v));
#endif
}
void scale_columns (
tensor& out,
const tensor& m,
const tensor& v
)
{
DLIB_CASSERT(have_same_dimensions(out,m));
DLIB_CASSERT(is_vector(v));
if (m.size() == 0 && v.size() == 0)
return;
DLIB_CASSERT(m.size() != 0);
DLIB_CASSERT(m.size()/m.num_samples() == v.size());
#ifdef DLIB_USE_CUDA
cuda::scale_columns(out, m, v);
#else
DLIB_CASSERT(false, "shouldn't be called right now");
out = scale_columns(mat(m), mat(v));
#endif
}
void scale_rows2 (
float beta,
tensor& out,
const tensor& m1,
const tensor& m2,
const tensor& v1,
const tensor& v2
)
{
DLIB_CASSERT(have_same_dimensions(out,m1));
DLIB_CASSERT(have_same_dimensions(out,m2));
DLIB_CASSERT(have_same_dimensions(v1,v2));
DLIB_CASSERT(is_vector(mat(v1)));
DLIB_CASSERT(v1.size() == m1.num_samples());
#ifdef DLIB_USE_CUDA
cuda::scale_rows2(beta, out, m1, m2, v1, v2);
#else
if (beta == 0)
out = scale_rows(mat(m1) - scale_rows(mat(m2),mat(v1)), mat(v2));
else
out = beta*mat(out) + scale_rows(mat(m1) - scale_rows(mat(m2),mat(v1)), mat(v2));
#endif
}
char *look_in_lisp_variable(char *o, int prefix)
{
Lisp_Object nil, var;
/*
* I will start by tagging a '$' (or whatever) on in front of the
* parameter name.
*/
o[0] = (char)prefix;
var = make_undefined_symbol(o);
nil = C_nil;
/*
* make_undefined_symbol() could fail either if we had utterly run out
* of memory or if somebody generated an interrupt (eg ^C) around now. Ugh.
*/
if (exception_pending())
{ flip_exception();
return NULL;
}
/*
* If the variable $name was undefined then I use an empty replacement
* text for it. Otherwise I need to look harder at its value.
*/
if (qvalue(var) == unset_var) return o;
else
{ Header h;
intptr_t len;
var = qvalue(var);
/*
* Mostly I expect that the value will be a string or symbol.
*/
#ifdef COMMON
if (complex_stringp(var))
{ var = simplify_string(var);
nil = C_nil;
if (exception_pending())
{ flip_exception();
return NULL;
}
}
#endif /* COMMON */
if (symbolp(var))
{ var = get_pname(var);
nil = C_nil;
if (exception_pending())
{ flip_exception();
return NULL;
}
h = vechdr(var);
}
else if (!is_vector(var) ||
type_of_header(h = vechdr(var)) != TYPE_STRING)
return NULL;
len = length_of_header(h) - CELL;
/*
* Copy the characters from the string or from the name of the variable
* into the file-name buffer. There could at present be a crash here
* if the expansion was very very long and overflowed my buffer. Tough
* luck for now - people doing that (maybe) get what they (maybe) deserve.
*/
memcpy(o, (char *)var + (CELL - TAG_VECTOR), (size_t)len);
o = o + len;
return o;
}
}
int Dim::max_index() const {
if (is_scalar()) return 0;
else if (is_vector()) return vec_size()-1;
else if (type()==MATRIX) return dim2-1;
else return dim1-1;
}
/// is var a collection type?
bool is_collection() const { return is_vector() || is_map(); }
SEXP flatten_impl(SEXP x) {
if (TYPEOF(x) != VECSXP) {
stop_bad_type(x, "a list", NULL, ".x");
}
int m = Rf_length(x);
// Determine output size and check type
int n = 0;
int has_names = 0;
SEXP x_names = PROTECT(Rf_getAttrib(x, R_NamesSymbol));
for (int j = 0; j < m; ++j) {
SEXP x_j = VECTOR_ELT(x, j);
if (!is_vector(x_j) && x_j != R_NilValue) {
stop_bad_element_type(x_j, j + 1, "a vector", NULL, ".x");
}
n += Rf_length(x_j);
if (!has_names) {
if (!Rf_isNull(Rf_getAttrib(x_j, R_NamesSymbol))) {
// Sub-element is named
has_names = 1;
} else if (Rf_length(x_j) == 1 && !Rf_isNull(x_names)) {
// Element is a "scalar" and has name in parent
SEXP name = STRING_ELT(x_names, j);
if (name != NA_STRING && strcmp(CHAR(name), "") != 0)
has_names = 1;
}
}
}
SEXP out = PROTECT(Rf_allocVector(VECSXP, n));
SEXP names = PROTECT(Rf_allocVector(STRSXP, n));
if (has_names)
Rf_setAttrib(out, R_NamesSymbol, names);
int i = 0;
for (int j = 0; j < m; ++j) {
SEXP x_j = VECTOR_ELT(x, j);
int n_j = Rf_length(x_j);
SEXP names_j = PROTECT(Rf_getAttrib(x_j, R_NamesSymbol));
int has_names_j = !Rf_isNull(names_j);
for (int k = 0; k < n_j; ++k, ++i) {
switch(TYPEOF(x_j)) {
case LGLSXP: SET_VECTOR_ELT(out, i, Rf_ScalarLogical(LOGICAL(x_j)[k])); break;
case INTSXP: SET_VECTOR_ELT(out, i, Rf_ScalarInteger(INTEGER(x_j)[k])); break;
case REALSXP: SET_VECTOR_ELT(out, i, Rf_ScalarReal(REAL(x_j)[k])); break;
case CPLXSXP: SET_VECTOR_ELT(out, i, Rf_ScalarComplex(COMPLEX(x_j)[k])); break;
case STRSXP: SET_VECTOR_ELT(out, i, Rf_ScalarString(STRING_ELT(x_j, k))); break;
case RAWSXP: SET_VECTOR_ELT(out, i, Rf_ScalarRaw(RAW(x_j)[k])); break;
case VECSXP: SET_VECTOR_ELT(out, i, VECTOR_ELT(x_j, k)); break;
default:
Rf_error("Internal error: `flatten_impl()` should have failed earlier");
}
if (has_names) {
if (has_names_j) {
SET_STRING_ELT(names, i, has_names_j ? STRING_ELT(names_j, k) : Rf_mkChar(""));
} else if (n_j == 1) {
SET_STRING_ELT(names, i, !Rf_isNull(x_names) ? STRING_ELT(x_names, j) : Rf_mkChar(""));
}
}
if (i % 1024 == 0)
R_CheckUserInterrupt();
}
UNPROTECT(1);
}
UNPROTECT(3);
return out;
}
void check_arg_type(char *func, char* loc, cellpoint arg, int type)
{
switch (type){
case BOOLEAN_T:
if (is_false(is_boolean(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a boolean, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case CHARACTER_T:
if (is_false(is_char(arg))){
printf("Errror: procedure \"%s\" expects the %s argument is a character, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case INTEGER_T:
if (is_false(is_integer(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a integer, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case NUMBER_T:
if (is_false(is_number(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a number, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case SYMBOL_T:
if (is_false(is_symbol(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a symbol, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case STRING_T:
if (is_false(is_string(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a string, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case VECTOR_T:
if (is_false(is_vector(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a vector, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case PAIR_T:
if (is_false(is_pair(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a pair, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case LIST_T:
if (is_false(is_list(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a list, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
case PROCEDURE_T:
if (is_false(is_procedure(arg))){
printf("Error: procedure \"%s\" expects the %s argument is a procedure, but given: ", func, loc);
write(arg);
newline();
error_handler();
}
break;
default:
printf("Error: unknown check arg type. -- CHECK_ARG_TYPE.\n");
error_handler();
}
}
