/Users/mourrain/Devel/mmx/basix/glue/glue_vector_map.cpp

Go to the documentation of this file.

/******************************************************************************
* MODULE     : glue_vector_generic_extra.cpp
* DESCRIPTION: Extra glue for vectors
* COPYRIGHT  : (C) 2006  Joris van der Hoeven
*******************************************************************************
* This software falls under the GNU general public license and comes WITHOUT
* ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for more details.
* If you don't have this file, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
******************************************************************************/

#include <basix/vector.hpp>
#include <basix/vector_sort.hpp>
#include <basix/glue.hpp>
#include <basix/routine.hpp>
namespace mmx {

static generic
rebuild (const vector<generic>& v) {
  if (is_a_scalar (v)) {
    generic make_vector= eval ("scalar_vector");
    return as<routine> (make_vector) -> apply (vec<generic> (v.scalar()));
  }
  else {
    generic make_vector= eval ("vector");
    return as<routine> (make_vector) -> apply (v);
  }
}

vector<generic>
vector_map_1 (const routine& fun, const vector<generic>& v) {
  if (is_a_scalar (v)) mmout << fun << ", " << v << "\n";
  //mmout << fun << ", " << v << ", " << is_a_scalar (v) << "\n";
  if (is_a_scalar (v)) return vector<generic> (fun->apply (v.scalar()));
  nat n= N(v);
  generic* r= mmx_new<generic> (n);
  for (nat i=0; i<n; i++)
    r[i]= fun->apply (v[i]);
  //mmout << "  -> " << vector<generic> (r, n) << "\n";
  return vector<generic> (r, n, format<generic> ());
}

vector<generic>
vector_map_2 (const routine& fun,
              const vector<generic>& v1, const vector<generic>& v2)
{
  if (is_a_scalar (v1) || is_a_scalar (v2)) {
    if (is_non_scalar (v1)) return vector_map_2 (fun, v1, extend (v2, v1));
    if (is_non_scalar (v2)) return vector_map_2 (fun, extend (v1, v2), v2);
    return vector<generic> (fun->apply (v1.scalar(), v2.scalar()));
  }
  ASSERT (N (v1) == N (v2), "vectors of unequal lengths");
  nat n= N(v1);
  generic* r= mmx_new<generic> (n);
  for (nat i=0; i<n; i++)
    r[i]= fun->apply (v1[i], v2[i]);
  return vector<generic> (r, n, format<generic> ());
}

vector<generic>
vector_map_n (const routine& fun, const vector<vector<generic> >& a) {
  bool all_scalar= true, one_scalar= false;
  nat i, n= N(a), l= 0;
  for (i=0; i<n; i++)
    if (is_a_scalar (a[i])) one_scalar= true;
    else {
      if (all_scalar) l= N(a[i]);
      else ASSERT (N(a[i]) == l, "vectors of unequal lengths");
      all_scalar= false;
    }

  if (all_scalar) {
    vector<generic> arg= fill<generic> (n);
    for (i=0; i<n; i++)
      arg[i]= a[i].scalar();
    return vector<generic> (fun->apply (arg));
  }

  if (one_scalar) {
    vector<vector<generic> > b= fill<vector<generic> > (n);
    for (i=0; i<n; i++)
      if (is_a_scalar (a[i])) b[i]= vector<generic> (a[i].scalar(), l);
      else b[i]= a[i];
    return vector_map_n (fun, b);
  }

  generic* r= mmx_new<generic> (l);
  for (nat j=0; j<l; j++) {
    vector<generic> arg= fill<generic> (n);
    for (i=0; i<n; i++)
      arg[i]= a[i][j];
    r[j]= fun->apply (arg);
  }
  return vector<generic> (r, l, format<generic> ());
}

generic
vector_map (const generic& f, const tuple<vector<generic> >& t) {
  routine fun= is<routine> (f)? as<routine> (f): default_routine (f);
  switch (N(t)) {
  case 0: ASSERT (N(t)>0, "wrong number of arguments");
  case 1: return rebuild (vector_map_1 (fun, t[0]));
  case 2: return rebuild (vector_map_2 (fun, t[0], t[1]));
  default:
    {
      const vector<generic> a= compound_to_vector (*t);
      nat i, n= N(a)-1;
      vector<vector<generic> > b= fill<vector<generic> > (n);
      for (i=0; i<n; i++) b[i]= as<vector<generic> > (a[i+1]);
      return rebuild (vector_map_n (fun, b));
    }
  }
}

generic
vector_foreach (const generic& f, const tuple<vector<generic> >& t) {
  generic r= vector_map (f, t);
  return as<generic> (tuple<generic> (gen (GEN_TUPLE)));
}

generic
vector_append_several (const tuple<vector<generic> >& t) {
  vector<generic> r;
  for (nat i=0; i<N(t); i++)
    r << t[i];
  return rebuild (r);
}

generic
vector_apply (const generic& f, const vector<generic>& a) {
  routine fun= is<routine> (f)? as<routine> (f): default_routine (f);
  return fun->apply (a);
}

static routine current_comparison;

vector<generic>
vector_sort (const vector<generic>& v) {
  vector<generic> r= copy (v);
  sort (r);
  return r;
}

struct vector_sort_leq_op {
  static bool
  op (const generic& x, const generic& y) {
    return as<bool> (current_comparison->apply (x, y));
  }
};

vector<generic>
vector_sort_leq (const vector<generic>& v, const generic& f) {
  routine old_comparison= current_comparison;
  current_comparison= is<routine> (f)? as<routine> (f): default_routine (f);
  vector<generic> r= copy (v);
  sort_leq<vector_sort_leq_op> (r);
  current_comparison= old_comparison;
  return r;
}

void
glue_vector_map () {
  static bool done = false;
  if (done) return;
  done = true;
  register_glue ("glue_vector_map", &glue_vector_map);
  call_glue ("glue_vector_generic");
  define ("map", vector_map);
  define ("foreach", vector_foreach);
  define ("append", vector_append_several);
  define ("apply", vector_apply);
  define ("sort", vector_sort);
  define ("sort", vector_sort_leq);
}

} // namespace mmx