// ---------------------------------------------------------------------------
// - Rmatrix.cpp                                                             -
// - afnix:mth module - real matrix implementation                           -
// ---------------------------------------------------------------------------
// - This program is free software;  you can redistribute it  and/or  modify -
// - it provided that this copyright notice is kept intact.                  -
// -                                                                         -
// - This program  is  distributed in  the hope  that it will be useful, but -
// - without  any  warranty;  without  even   the   implied    warranty   of -
// - merchantability or fitness for a particular purpose.  In no event shall -
// - the copyright holder be liable for any  direct, indirect, incidental or -
// - special damages arising in any way out of the use of this software.     -
// ---------------------------------------------------------------------------
// - copyright (c) 1999-2013 amaury darsch                                   -
// ---------------------------------------------------------------------------

#include "Rmd.hpp"
#include "Real.hpp"
#include "Math.hpp"
#include "Mthsid.hxx"
#include "Vector.hpp"
#include "Utility.hpp"
#include "Rmatrix.hpp"
#include "Algebra.hpp"
#include "Exception.hpp"
 
namespace afnix {

  // -------------------------------------------------------------------------
  // - private section                                                       -
  // -------------------------------------------------------------------------

  // the row/col index size
  static const long ROW_RMLB_SIZE = 16;
  static const long COL_RMLB_SIZE = 16;
  static const long ROW_RMCB_SIZE = 256;
  static const long COL_RMCB_SIZE = 256;
  static const long ROW_RMCC_SIZE = 256;
  static const long COL_RMCC_SIZE = 256;
  static const long ROW_RMCT_SIZE = 256;
  static const long COL_RMCT_SIZE = 256;
  static const long ROW_RMLT_SIZE = 16;
  static const long COL_RMLT_SIZE = 16;

  // the row/col index mask
  static const long ROW_RMLB_MASK = 0x0FUL;
  static const long COL_RMLB_MASK = 0x0FUL;
  static const long ROW_RMCB_MASK = 0xFFUL;
  static const long COL_RMCB_MASK = 0xFFUL;
  static const long ROW_RMCC_MASK = 0xFFUL;
  static const long COL_RMCC_MASK = 0xFFUL;
  static const long ROW_RMCT_MASK = 0xFFUL;
  static const long COL_RMCT_MASK = 0xFFUL;
  static const long ROW_RMLT_MASK = 0x0FUL;
  static const long COL_RMLT_MASK = 0x0FUL;
  static const long ROW_RMHB_MASK = 0xFFFFFFFFUL;
  static const long COL_RMHB_MASK = 0xFFFFFFFFUL;

  // the row/col shift mask
  static const long ROW_RMCB_SHFT = 4;
  static const long COL_RMCB_SHFT = 4;
  static const long ROW_RMCC_SHFT = 12;
  static const long COL_RMCC_SHFT = 12;
  static const long ROW_RMCT_SHFT = 20;
  static const long COL_RMCT_SHFT = 20;
  static const long ROW_RMLT_SHFT = 28;
  static const long COL_RMLT_SHFT = 28;
  static const long ROW_RMHB_SHFT = 32;
  static const long COL_RMHB_SHFT = 32;

  // the block array size
  static const long BLK_RMLB_SIZE = ROW_RMLB_SIZE * COL_RMLB_SIZE;
  static const long BLK_RMCB_SIZE = ROW_RMCB_SIZE * COL_RMCB_SIZE;
  static const long BLK_RMCC_SIZE = ROW_RMCC_SIZE * COL_RMCC_SIZE;
  static const long BLK_RMCT_SIZE = ROW_RMCT_SIZE * COL_RMCT_SIZE;
  static const long BLK_RMLT_SIZE = ROW_RMLT_SIZE * COL_RMLT_SIZE;
  
  // this procedure create a new lb block
  static inline Rmatrix::t_rmlb rm_new_lb (void) {
    // allocate and clear
    Rmatrix::t_rmlb result = new t_real[BLK_RMLB_SIZE];
    for (long k = 0; k < BLK_RMLB_SIZE; k++) result[k] = 0.0;
    return result;
  }

  // this procedure copy a lb block
  static inline Rmatrix::t_rmlb rm_copy_lb (const Rmatrix::t_rmlb lb) {
    // check for nil
    if (lb == nilp) return nilp;
    // allocate and copy
    Rmatrix::t_rmlb result = new t_real[BLK_RMLB_SIZE];
    for (long k = 0; k < BLK_RMLB_SIZE; k++) result[k] = lb[k];
    return result;
  }

  // this procedure free a lb block
  static inline void rm_free_lb (const Rmatrix::t_rmlb lb) {
    if (lb != nilp) delete [] lb;
  }

  // this procedure maps the lb index by row and column
  static inline long rm_indx_lb (const t_long row, const t_long col) {
    return (row & ROW_RMLB_MASK) * ROW_RMLB_SIZE + (col & COL_RMLB_MASK);
  }

  // this procedure creates a new cb block
  static inline Rmatrix::t_rmcb rm_new_cb (void) {
    // allocate and clear
    Rmatrix::t_rmcb result = new Rmatrix::t_rmlb[BLK_RMCB_SIZE];
    for (long k = 0; k < BLK_RMCB_SIZE; k++) result[k] = nilp;
    return result;
  }

  // this procedure copy a cb block
  static inline Rmatrix::t_rmcb rm_copy_cb (const Rmatrix::t_rmcb cb) {
    // check for nil
    if (cb == nilp) return nilp;
    // allocate and copy
    Rmatrix::t_rmcb result = new Rmatrix::t_rmlb[BLK_RMCB_SIZE];
    for (long k = 0; k < BLK_RMCB_SIZE; k++) result[k] = rm_copy_lb (cb[k]);
    return result;
  }

  // this procedure free a cb block
  static inline void rm_free_cb (const Rmatrix::t_rmcb cb) {
    if (cb == nilp) return;
    for (long k = 0; k < BLK_RMCB_SIZE; k++) rm_free_lb (cb[k]);
    delete [] cb;
  }

  // this procedure maps the cb index by row and column
  static inline long rm_indx_cb (const t_long row, const t_long col) {
    long rix = (row >> ROW_RMCB_SHFT) & ROW_RMCB_MASK;
    long cix = (col >> COL_RMCB_SHFT) & COL_RMCB_MASK;
    return (rix * ROW_RMCB_SIZE) + cix;
  }

  // this procedure creates a new cc block
  static inline Rmatrix::t_rmcc rm_new_cc (void) {
    // allocate and clear
    Rmatrix::t_rmcc result = new Rmatrix::t_rmcb[BLK_RMCC_SIZE];
    for (long k = 0; k < BLK_RMCC_SIZE; k++) result[k] = nilp;
    return result;
  }

  // this procedure copy a cc block
  static inline Rmatrix::t_rmcc rm_copy_cc (const Rmatrix::t_rmcc cc) {
    // check for nil
    if (cc == nilp) return nilp;
    // allocate and copy
    Rmatrix::t_rmcc result = new Rmatrix::t_rmcb[BLK_RMCC_SIZE];
    for (long k = 0; k < BLK_RMCC_SIZE; k++) result[k] = rm_copy_cb (cc[k]);
    return result;
  }

  // this procedure free a cc block
  static inline void rm_free_cc (const Rmatrix::t_rmcc cc) {
    if (cc == nilp) return;
    for (long k = 0; k < BLK_RMCC_SIZE; k++) rm_free_cb (cc[k]);
    delete [] cc;
  }

  // this procedure maps the cc index by row and column
  static inline long rm_indx_cc (const t_long row, const t_long col) {
    long rix = (row >> ROW_RMCC_SHFT) & ROW_RMCC_MASK;
    long cix = (col >> COL_RMCC_SHFT) & COL_RMCC_MASK;
    return (rix * ROW_RMCC_SIZE) + cix;
  }

  // this procedure creates a new ct block
  static inline Rmatrix::t_rmct rm_new_ct (void) {
    // allocate and clear
    Rmatrix::t_rmct result = new Rmatrix::t_rmcc[BLK_RMCT_SIZE];
    for (long k = 0; k < BLK_RMCT_SIZE; k++) result[k] = nilp;
    return result;
  }

  // this procedure copy a ct block
  static inline Rmatrix::t_rmct rm_copy_ct (const Rmatrix::t_rmct ct) {
    // check for nil
    if (ct == nilp) return nilp;
    // allocate and copy
    Rmatrix::t_rmct result = new Rmatrix::t_rmcc[BLK_RMCT_SIZE];
    for (long k = 0; k < BLK_RMCT_SIZE; k++) result[k] = rm_copy_cc (ct[k]);
    return result;
  }

  // this procedure free a ct block
  static inline void rm_free_ct (const Rmatrix::t_rmct ct) {
    if (ct == nilp) return;
    for (long k = 0; k < BLK_RMCT_SIZE; k++) rm_free_cc (ct[k]);
    delete [] ct;
  }

  // this procedure maps the ct index by row and column
  static inline long rm_indx_ct (const t_long row, const t_long col) {
    long rix = (row >> ROW_RMCT_SHFT) & ROW_RMCT_MASK;
    long cix = (col >> COL_RMCT_SHFT) & COL_RMCT_MASK;
    return (rix * ROW_RMCT_SIZE) + cix;
  }

  // this procedure creates a new lt block
  static inline Rmatrix::t_rmlt rm_new_lt (void) {
    // allocate and clear
    Rmatrix::t_rmlt result = new Rmatrix::t_rmct[BLK_RMLT_SIZE];
    for (long k = 0; k < BLK_RMLT_SIZE; k++) result[k] = nilp;
    return result;
  }

  // this procedure copy a lt block
  static inline Rmatrix::t_rmlt rm_copy_lt (const Rmatrix::t_rmlt lt) {
    // check for nil
    if (lt == nilp) return nilp;
    // allocate and copy
    Rmatrix::t_rmlt result = new Rmatrix::t_rmct[BLK_RMLT_SIZE];
    for (long k = 0; k < BLK_RMLT_SIZE; k++) result[k] = rm_copy_ct (lt[k]);
    return result;
  }

  // this procedure free a lt block
  static inline void rm_free_lt (const Rmatrix::t_rmlt lt) {
    if (lt == nilp) return;
    for (long k = 0; k < BLK_RMLT_SIZE; k++) rm_free_ct (lt[k]);
    delete [] lt;
  }

  // this procedure maps the lt index by row and column
  static inline long rm_indx_lt (const t_long row, const t_long col) {
    long rix = (row >> ROW_RMLT_SHFT) & ROW_RMLT_MASK;
    long cix = (col >> COL_RMLT_SHFT) & COL_RMLT_MASK;
    return (rix * ROW_RMLT_SIZE) + cix;
  }

  // this procedure computes the hb array size
  static inline long rm_size_hb (const t_long rsiz, const t_long csiz) {
    long rsz = ((rsiz >> ROW_RMHB_SHFT) & ROW_RMHB_MASK) + 1;
    long csz = ((csiz >> ROW_RMHB_SHFT) & ROW_RMHB_MASK) + 1;
    return rsz * csz;
  }

  // this procedure creates a new hb array by size
  static inline Rmatrix::t_rmhb rm_new_hb (const t_long rsiz, 
					   const t_long csiz) {
    // get the hb array size
    long hbsz = rm_size_hb (rsiz, csiz);
    // allocate and clear
    Rmatrix::t_rmhb result = new Rmatrix::t_rmlt[hbsz];
    for (long k = 0; k < hbsz; k++) result[k] = nilp;
    return result;
  }

  // this procedure copy a hb block
  static inline Rmatrix::t_rmhb rm_copy_hb (const t_long rsiz, 
					    const t_long csiz,
					    const Rmatrix::t_rmhb hb) {
    // get hb size and check for nil
    long hbsz = rm_size_hb (rsiz, csiz);
    if ((hbsz <= 0) || (hb == nilp)) return nilp;
    // allocate and copy
    Rmatrix::t_rmhb result = new Rmatrix::t_rmlt[hbsz];
    for (long k = 0; k < hbsz; k++) result[k] = rm_copy_lt (hb[k]);
    return result;
  }
  
  // this procedure free a hb block
  static inline void rm_free_hb (const t_long rsiz, const t_long csiz,
				 const Rmatrix::t_rmhb hb) {
    // get hb size and check for nil
    long hbsz = rm_size_hb (rsiz, csiz);
    if ((hbsz <= 0) || (hb == nilp)) return;
    // clean the array
    for (long k = 0; k < hbsz; k++) rm_free_lt (hb[k]);
    delete [] hb;
  }
    
  // this procedure maps the hb index by row and column
  static inline long rm_indx_hb (const t_long row,  const t_long col,
				 const t_long rsiz, const t_long csiz) {
    // get size and index
    long rix = (row   >> ROW_RMHB_SHFT) & ROW_RMHB_MASK;
    long cix = (col   >> COL_RMHB_SHFT) & COL_RMHB_MASK;
    long rsz = ((rsiz >> ROW_RMHB_SHFT) & ROW_RMHB_MASK) + 1;
    long csz = ((csiz >> COL_RMHB_SHFT) & COL_RMHB_MASK) + 1;
    // check valid index
    if ((rix < 0) || (rix >= rsz) || (cix < 0) || (cix >= csz)) {
      throw Exception ("internal-error", "out of range rmatrix hb indexes");
    }
    // map the hb index in row mode
    return (rix * csz) + cix;
  }

  // this procedure find the lb block by coordinates
  static Rmatrix::t_rmlb rm_find_lb (Rmatrix::t_rmhb hb, const t_long row,
				     const t_long col,   const t_long rsiz,
				     const t_long csiz,  const bool   cflg) {
    // check for nil first
    if (hb == nilp) {
      throw Exception ("internal-error", "invalid nil hb in lb find");
    }
    // get the indexes
    long hbi = rm_indx_hb (row, col, rsiz, csiz);
    long lti = rm_indx_lt (row, col);
    long cti = rm_indx_ct (row, col);
    long cci = rm_indx_cc (row, col);
    long cbi = rm_indx_cb (row, col);
    // map the lt block if needed
    Rmatrix::t_rmlt lt = hb[hbi];
    if (lt == nilp) {
      if (cflg == false) return nilp;
      lt = hb[hbi] = rm_new_lt ();
    }
    // map the ct block if needed
    Rmatrix::t_rmct ct = lt[lti];
    if (ct == nilp) {
      if (cflg == false) return nilp;
      ct = lt[lti] = rm_new_ct ();
    }
    // map the cc block if needed
    Rmatrix::t_rmcc cc = ct[cti];
    if (cc == nilp) {
      if (cflg == false) return nilp;
      cc = ct[cti] = rm_new_cc ();
    }
    // map the cb block if needed
    Rmatrix::t_rmcb cb = cc[cci];
    if (cb == nilp) {
      if (cflg == false) return nilp;
      cb = cc[cci] = rm_new_cb ();
    }
    // map the lb block if needed
    Rmatrix::t_rmlb lb = cb[cbi];
    if (lb == nilp) {
      if (cflg == false) return nilp;
      lb = cb[cbi] = rm_new_lb ();
    }
    // here it is
    return lb;
  }

  // -------------------------------------------------------------------------
  // - public section                                                        -
  // -------------------------------------------------------------------------

  // generate a square random matrix by size

  Rmatrix* Rmatrix::random (const t_long size, const t_real rmin,
			    const t_real rmax) {
    // create a matrix by size
    Rmatrix* result = new Rmatrix (size);
    // fill the matrix
    Algebra::random (*result, rmin, rmax);
    // here it is
    return result;
  }

  // generate a square random matrix by size

  Rmatrix* Rmatrix::random (const t_long size, const t_real rmin,
			    const t_real rmax, const bool   ddom) {
    // create a matrix by size
    Rmatrix* result = new Rmatrix (size);
    // fill the matrix
    Algebra::random (*result, rmin, rmax);
    // force it dominant if requested
    if (ddom == true) Algebra::toddom (*result, (rmax + rmin) / 2.0);
    // here it is
    return result;
  }

  // generate a square sparse matrix by size

  Rmatrix* Rmatrix::sparse (const t_long size, const t_real rmin,
			    const t_real rmax, const t_long nzsz) {
    // create a matrix by size
    Rmatrix* result = new Rmatrix (size);
    // fill the matrix
    Algebra::sparse (*result, rmin, rmax, nzsz);
    // here it is
    return result;
  }

  // add a matrix with another one

  Rmatrix operator + (const Rmatrix& mx, const Rmatrix& my) {
    mx.rdlock ();
    my.rdlock ();
    try {
      // create a result matrix
      Rmatrix mr (mx.getrsiz (), my.getcsiz ());
      // add the matrices
      Algebra::add (mr, mx, my);
      // unlock and return
      mx.unlock ();
      my.unlock ();
      return mr;
    } catch (...) {
      mx.unlock ();
      my.unlock ();
      throw;
    }
  }

  // substract a matrix with another one

  Rmatrix operator - (const Rmatrix& mx, const Rmatrix& my) {
    mx.rdlock ();
    my.rdlock ();
    try {
      // create a result matrix
      Rmatrix mr (mx.getrsiz (), my.getcsiz ());
      // substract the matrices
      Algebra::sub (mr, mx, my);
      // unlock and return
      mx.unlock ();
      my.unlock ();
      return mr;
    } catch (...) {
      mx.unlock ();
      my.unlock ();
      throw;
    }
  }

  // multiply a matrix with a vector

  Rvector operator * (const Rmatrix& m, const Rvector& x) {
    m.rdlock ();
    x.rdlock ();
    try {
      // extract operating size
      t_long rows = m.getrsiz ();
      // create result vector
      Rvector r (rows);
      // perform the operation
      m.mul (r, x, 1.0);
      // unlock and return
      m.unlock ();
      x.unlock ();
      return r;
    } catch (...) {
      m.unlock ();
      x.unlock ();
      throw;
    }
  }

  // multiply two matrices

  Rmatrix operator * (const Rmatrix& mx, const Rmatrix& my) {
    mx.rdlock ();
    my.rdlock ();
    try {
      // create a result matrix
      Rmatrix mr (mx.getrsiz (), my.getcsiz ());
      // muliply the matrices
      Algebra::mul (mr, mx, my);
      // unlock and return
      mx.unlock ();
      my.unlock ();
      return mr;
    } catch (...) {
      mx.unlock ();
      my.unlock ();
      throw;
    }
  }

  // this procedure returns a new matrix for deserialization
  static Serial* mksob (void) {
    return new Rmatrix;
  }
  // register the anonymous matrix serial id
  static const t_byte SERIAL_ID = Serial::setsid (SERIAL_ARMI_ID, mksob);

  // -------------------------------------------------------------------------
  // - class section                                                         -
  // -------------------------------------------------------------------------

  // create a default matrix

  Rmatrix::Rmatrix (void) {
    p_rmhb = nilp;
  }

  // create a square matrix by size

  Rmatrix::Rmatrix (const t_long size) : Rmi (size) {
    p_rmhb = rm_new_hb (d_rsiz, d_csiz);
  }

  // create a matrix by size

  Rmatrix::Rmatrix (const t_long rsiz, const t_long csiz) : Rmi (rsiz, csiz) {
    p_rmhb = rm_new_hb (d_rsiz, d_csiz);
  }

  // copy construct this matrix

  Rmatrix::Rmatrix (const Rmatrix& that) {
    that.rdlock ();
    try {
      // copy the size and allocate
      d_rsiz = that.d_rsiz;
      d_csiz = that.d_csiz;
      p_rmhb = rm_copy_hb (d_rsiz, d_csiz, that.p_rmhb);
      that.unlock ();
    } catch (...) {
      that.unlock ();
      throw;
    }
  }
	
  // destroy this matrix

  Rmatrix::~Rmatrix (void) {
    rm_free_hb (d_rsiz, d_csiz, p_rmhb);
  }

  // return the class name

  String Rmatrix::repr (void) const {
    return "Rmatrix";
  }

  // return a clone of this object

  Object* Rmatrix::clone (void) const {
    return new Rmatrix (*this);
  }

  // assign a matrix to this one

  Rmatrix& Rmatrix::operator = (const Rmatrix& that) {
    // check for self-assignation
    if (this == &that) return *this;
    // lock and assign
    wrlock ();
    that.rdlock ();
    try {
      // delete the old matrix
      rm_free_hb (d_rsiz, d_csiz, p_rmhb);
      p_rmhb = nilp;
      // copy the new matrix
      d_rsiz = that.d_rsiz;
      d_csiz = that.d_csiz;
      p_rmhb = rm_copy_hb (d_rsiz, d_csiz, that.p_rmhb);
      // unlock and return
      unlock ();
      that.unlock ();
      return *this;
    } catch (...) {
      that.unlock ();
      throw;
    }
  }

  // resize this matrix

  void Rmatrix::resize (const t_long rsiz, const t_long csiz) {
    wrlock ();
    try {
      // check for valid size
      if ((rsiz < 0) || (csiz < 0)) {
	throw Exception ("rmatrix-error", "invalid resize parameters");
      }
      // get the current hb block size
      long cbsz = rm_size_hb (d_rsiz, d_csiz);
      // get the new hb block size
      long nbsz = rm_size_hb (rsiz, csiz);
      // check for lower
      if (nbsz < cbsz) {
	t_rmhb rmhb = rm_new_hb (rsiz, csiz);
	for (long k = 0; k < nbsz; k++) rmhb[k] = p_rmhb[k];
	for (long k = nbsz; k < cbsz; k++) rm_free_lt (p_rmhb[k]);
	delete [] p_rmhb;
	p_rmhb = rmhb;
      }
      // check for higher
      if (nbsz > cbsz) {
	t_rmhb rmhb = rm_new_hb (rsiz, csiz);
	for (long k = 0; k < cbsz; k++) rmhb[k] = p_rmhb[k];
	delete [] p_rmhb;
	p_rmhb = rmhb;
      }
      // check for nil with non null size
      if ((p_rmhb == nilp) && (rsiz > 0) && (csiz > 0)) {
	p_rmhb = rm_new_hb (rsiz, csiz);
	for (long k = 0; k < nbsz; k++) p_rmhb[k] = nilp;
      }
      // update size and return
      d_rsiz = rsiz;
      d_csiz = csiz;
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // clear this matrix

  void Rmatrix::clear (void) {
    wrlock ();
    try {
      // destroy all hb array
      rm_free_hb (d_rsiz, d_csiz, p_rmhb);
      // rebuild fresh array
      p_rmhb = rm_new_hb (d_rsiz, d_csiz);;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set a matrix by position

  void Rmatrix::set (const t_long row, const t_long col, const t_real val) {
    wrlock ();
    try {
      // check for valid position
      if ((row < 0) || (row >= d_rsiz) ||
	  (col < 0) || (col >= d_csiz)) {
	throw Exception ("index-error", "invalid matrix position in set");
      }
      // set the block creation flag
      bool cflg = (val == 0.0) ? false : true;
      // get the lb block by position
      Rmatrix::t_rmlb lb = rm_find_lb (p_rmhb, row, col, d_rsiz, d_csiz, cflg);
      if ((lb == nilp) && (cflg == false)) {
	unlock ();
	return;
      }
      if ((lb == nilp) && (cflg == true)) {
	throw Exception ("internal-error", "invalid nil lb block in set");
      }
      // map the lb index and set
      long lbi = rm_indx_lb (row, col);
      lb[lbi] = val;
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set a matrix by position

  t_real Rmatrix::get (const t_long row, const t_long col) const {
    rdlock ();
    try {
      // check for valid position
      if ((row < 0) || (row >= d_rsiz) ||
	  (col < 0) || (col >= d_csiz)) {
	throw Exception ("index-error", "invalid matrix position in get");
      }
      // get the lb block by position
      Rmatrix::t_rmlb lb = rm_find_lb (p_rmhb, row, col, d_rsiz, d_csiz, false);
      if (lb == nilp) {
	unlock ();
	return 0.0;
      }
      // map the lb index and get
      long      lbi = rm_indx_lb (row, col);
      t_real result = lb[lbi];
      // unlock and return
      unlock ();
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // return a new matrix iterator

  Iterator* Rmatrix::makeit (void) {
    rdlock ();
    try {
      Iterator* result = new Rmatrixit (this);
      unlock ();
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }
  
  // -------------------------------------------------------------------------
  // - object section                                                        -
  // -------------------------------------------------------------------------

  // create a new object in a generic way

  Object* Rmatrix::mknew (Vector* argv) {
    long argc = (argv == nilp) ? 0 : argv->length ();
    
    // check for 0 argument
    if (argc == 0) return new Rmatrix;
    // check for 1 argument
    if (argc == 1) {
      t_long size = argv->getlong (0);
      return new Rmatrix (size);
    }
    // check for 2 arguments
    if (argc == 2) {
      t_long rsiz = argv->getlong (0);
      t_long csiz = argv->getlong (1);
      return new Rmatrix (rsiz, csiz);
    }
    // invalid arguments
    throw Exception ("argument-error", 
		     "invalid arguments with rmatrix object");
  }

  // return true if the given quark is defined

  bool Rmatrix::isquark (const long quark, const bool hflg) const {
    rdlock ();
    bool result = hflg ? Iterable::isquark (quark, hflg) : false;
    if (result == false) {
      result = hflg ? Rmi::isquark (quark, hflg) : false;
    }
    unlock ();
    return result;
  }

  // operate this matrix with another object

  Object* Rmatrix::oper (t_oper type, Object* object) {
    Rvector* vobj = dynamic_cast <Rvector*> (object);
    Rmatrix* mobj = dynamic_cast <Rmatrix*> (object);
    switch (type) {
    case Object::ADD:
      if (mobj != nilp) return new Rmatrix (*this + *mobj);
      break;
    case Object::SUB:
      if (mobj != nilp) return new Rmatrix (*this - *mobj);
      break;
    case Object::MUL:
      if (vobj != nilp) return new Rvector (*this * *vobj);
      if (mobj != nilp) return new Rmatrix (*this * *mobj);
      break;
    default:
      throw Exception ("matrix-error", "invalid operator with rmatrix",
		       Object::repr (object));
      break;
    }
    throw Exception ("type-error", "invalid operand with rmatrix",
		     Object::repr (object));
  }

  // apply this object with a set of arguments and a quark
  
  Object* Rmatrix::apply (Runnable* robj, Nameset* nset, const long quark,
			  Vector* argv) {
    // check the iterable method
    if (Iterable::isquark (quark, true) == true) {
      return Iterable::apply (robj, nset, quark, argv);
    }
    // call the rmi method
    return Rmi::apply (robj, nset, quark, argv);
  }

  // -------------------------------------------------------------------------
  // - iterator section                                                      -
  // -------------------------------------------------------------------------

  // create a new matrix iterator
  
  Rmatrixit::Rmatrixit (Rmatrix* mobj) {
    Object::iref (p_mobj = mobj);
    d_hbsz = (p_mobj == nilp) ? 0 : rm_size_hb (p_mobj->d_rsiz, p_mobj->d_csiz);
    begin ();
  }
  
  // destroy this matrix iterator
  
  Rmatrixit::~Rmatrixit (void) {
    Object::dref (p_mobj);
  }

  // return the class name

  String Rmatrixit::repr (void) const {
    return "Rmatrixit";
  }

  // reset the iterator to the begining

  void Rmatrixit::begin (void) {
    wrlock ();
    try {
      // reset indexes
      d_bihb = 0;
      d_bilt = 0;
      d_bict = 0;
      d_bicc = 0;
      d_bicb = 0;
      d_bilb = 0;
      // move to the next position if needed
      if (getval () == 0.0) next ();
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }
 
  // reset the iterator to the end

  void Rmatrixit::end (void) {
    wrlock ();
    try {
      // reset indexes
      d_bihb = d_hbsz-1;
      d_bilt = BLK_RMLT_SIZE-1;
      d_bict = BLK_RMCT_SIZE-1;
      d_bicc = BLK_RMCC_SIZE-1;
      d_bicb = BLK_RMCB_SIZE-1;
      d_bilb = BLK_RMLB_SIZE-1;
      // move the last end if needed
      if (getval () == 0.0) prev ();
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // move the iterator to the next position
  
  void Rmatrixit::next (void) {
    wrlock ();
    try {
      // lock the matrix
      if (p_mobj != nilp) p_mobj->rdlock ();
      // move to the next position
      mvnext ();
      // unlock and return
      if (p_mobj != nilp) p_mobj->unlock ();
      unlock ();
    } catch (...) {
      p_mobj->unlock ();
      unlock ();
      throw;
    }
  }

  // move the iterator to the previous position

  void Rmatrixit::prev (void) {
    wrlock ();
    try {
      // lock the matrix
      if (p_mobj != nilp) p_mobj->rdlock ();
      // move to the next position
      mvprev ();
      // unlock and return
      if (p_mobj != nilp) p_mobj->unlock ();
      unlock ();
    } catch (...) {
      p_mobj->unlock ();
      unlock ();
      throw;
    }
  }

  // get the object at the current position

  Object* Rmatrixit::getobj (void) const {
    rdlock ();
    try {
      if (p_mobj != nilp) p_mobj->rdlock ();
      Object* result = new Rmd (getrow (), getcol (), getval ());
      if (p_mobj != nilp) p_mobj->unlock ();
      unlock ();
      return result;
    } catch (...) {
      if (p_mobj != nilp) p_mobj->unlock ();
      unlock ();
      throw;
    }
  }
  
  // return true if the iterator is at the end

  bool Rmatrixit::isend (void) {
    rdlock ();
    try {
      bool result = (p_mobj == nilp) || (d_bihb >= d_hbsz);
      unlock ();
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // move the iterator to the next position (no lock)
  
  void Rmatrixit::mvnext (void) {
    // check for nil - double security
    if (p_mobj == nilp) return;
    // loop in the hb block
    for (long bihb = d_bihb; bihb < d_hbsz; bihb++) {
      // get the rmlt array
      Rmatrix::t_rmlt rmlt = p_mobj->p_rmhb[bihb];
      // check for a valid block and reset index
      if (rmlt == nilp) {
	d_bilt = 0;
	d_bict = 0;
	d_bicc = 0;
	d_bicb = 0;
	d_bilb = 0;
	continue;
      }
      // loop in the lt block
      for (long bilt = d_bilt; bilt < BLK_RMLT_SIZE; bilt++) {
	// get the rmct array
	Rmatrix::t_rmct rmct = rmlt[bilt];
	// check for a valid block and reset index
	if (rmct == nilp) {
	  d_bict = 0;
	  d_bicc = 0;
	  d_bicb = 0;
	  d_bilb = 0;
	  continue;
	}
	// loop in the ct block
	for (long bict = d_bict; bict < BLK_RMCT_SIZE; bict++) {
	  // get the rmcc array
	  Rmatrix::t_rmcc rmcc = rmct[bict];
	  // check for a valid block and reset index
	  if (rmcc == nilp) {
	    d_bicc = 0;
	    d_bicb = 0;
	    d_bilb = 0;
	    continue;
	  }
	  // loop in the cc block
	  for (long bicc = d_bicc; bicc < BLK_RMCC_SIZE; bicc++) {
	    // get the rmcb array
	    Rmatrix::t_rmcb rmcb = rmcc[bicc];
	    // check for a valid block and reset index
	    if (rmcb == nilp) {
	      d_bicb = 0;
	      d_bilb = 0;
	      continue;
	    }
	    // loop in the cb block
	    for (long bicb = d_bicb; bicb < BLK_RMCB_SIZE; bicb++) {
	      // get the rmlb array
	      Rmatrix::t_rmlb rmlb = rmcb[bicb];
	      // check for a valid block and reset index
	      if (rmlb == nilp) {
		d_bilb = 0;
		continue;
	      }
	      // loop in the lb block at next position
	      for (long bilb = d_bilb + 1; bilb < BLK_RMLB_SIZE; bilb++) {
		// get the value and check
		t_real val = rmlb[bilb];
		if (val != 0.0) {
		  d_bihb = bihb;
		  d_bilt = bilt;
		  d_bict = bict;
		  d_bicc = bicc;
		  d_bicb = bicb;
		  d_bilb = bilb;
		  return;
		}
	      }
	    }
	  }
	}
      }
    }
    // here we are at the end
    d_bihb = d_hbsz;
    d_bilt = BLK_RMLT_SIZE;
    d_bict = BLK_RMCT_SIZE;
    d_bicc = BLK_RMCC_SIZE;
    d_bicb = BLK_RMCB_SIZE;
    d_bilb = BLK_RMLB_SIZE;
  }
  
  // move the iterator to the previous position (no lock)
  
  void Rmatrixit::mvprev (void) {
    // check for nil - double security
    if (p_mobj == nilp) return;
    // loop in the hb block
    for (long bihb = d_bihb; bihb >= 0; bihb--) {
      // get the rmlt array
      Rmatrix::t_rmlt rmlt = p_mobj->p_rmhb[bihb];
      // check for a valid block and reset index
      if (rmlt == nilp) {
	d_bilt = BLK_RMLT_SIZE - 1;
	d_bict = BLK_RMCT_SIZE - 1;
	d_bicc = BLK_RMCC_SIZE - 1;
	d_bicb = BLK_RMCB_SIZE - 1;
	d_bilb = BLK_RMLB_SIZE - 1;
	continue;
      }
      // loop in the lt block
      for (long bilt = d_bilt; bilt >= 0; bilt--) {
	// get the rmct array
	Rmatrix::t_rmct rmct = rmlt[bilt];
	// check for a valid block and reset index
	if (rmct == nilp) {
	  d_bict = BLK_RMCT_SIZE - 1;
	  d_bicc = BLK_RMCC_SIZE - 1;
	  d_bicb = BLK_RMCB_SIZE - 1;
	  d_bilb = BLK_RMLB_SIZE - 1;
	  continue;
	}
	// loop in the ct block
	for (long bict = d_bict; bict >= 0;  bict--) {
	  // get the rmcc array
	  Rmatrix::t_rmcc rmcc = rmct[bict];
	  // check for a valid block and reset index
	  if (rmcc == nilp) {
	    d_bicc = BLK_RMCC_SIZE - 1;
	    d_bicb = BLK_RMCB_SIZE - 1;
	    d_bilb = BLK_RMLB_SIZE - 1;
	    continue;
	  }
	  // loop in the cc block
	  for (long bicc = d_bicc; bicc >= 0; bicc--) {
	    // get the rmcb array
	    Rmatrix::t_rmcb rmcb = rmcc[bicc];
	    // check for a valid block and reset index
	    if (rmcb == nilp) {
	      d_bicb = BLK_RMCB_SIZE - 1;
	      d_bilb = BLK_RMLB_SIZE - 1;
	      continue;
	    }
	    // loop in the cb block
	    for (long bicb = d_bicb; bicb >= 0; bicb--) {
	      // get the rmlb array
	      Rmatrix::t_rmlb rmlb = rmcb[bicb];
	      // check for a valid block and reset index
	      if (rmlb == nilp) {
		d_bilb = BLK_RMLB_SIZE - 1;
		continue;
	      }
	      // loop in the lb block at next position
	      for (long bilb = d_bilb -1; bilb >= 0; bilb--) {
		// get the value and check
		t_real val = rmlb[bilb];
		if (val != 0.0) {
		  d_bihb = bihb;
		  d_bilt = bilt;
		  d_bict = bict;
		  d_bicc = bicc;
		  d_bicb = bicb;
		  d_bilb = bilb;
		  return;
		}
	      }
	    }
	  }
	}
      }
    }
    // here we are at the beginning
    d_bihb = 0;
    d_bilt = 0;
    d_bict = 0;
    d_bicc = 0;
    d_bicb = 0;
    d_bilb = 0;
  }

  // get the row coordinate at the iterator position (no lock)
  
  t_long Rmatrixit::getrow (void) const {
    // check for nil first
    if (p_mobj == nilp) return 0;
    // check valid indexes
    if ((d_bihb < 0) || (d_bihb >= d_hbsz)) {
      throw Exception ("internal-error", "invalid hb index in getrow");
    }
    // check valid indexes
    if ((d_bilt < 0) || (d_bilt >= BLK_RMLT_SIZE)) {
      throw Exception ("internal-error", "invalid lt index in getrow");
    }
    if ((d_bict < 0) || (d_bict >= BLK_RMCT_SIZE)) {
      throw Exception ("internal-error", "invalid ct index in getrow");
    }
    if ((d_bicc < 0) || (d_bicc >= BLK_RMCC_SIZE)) {
      throw Exception ("internal-error", "invalid cc index in getrow");
    }
    if ((d_bicb < 0) || (d_bicb >= BLK_RMCB_SIZE)) {
      throw Exception ("internal-error", "invalid cb index in getrow");
    }
    if ((d_bilb < 0) || (d_bilb >= BLK_RMLB_SIZE)) {
      throw Exception ("internal-error", "invalid lb index in getrow");
    }
    // map the matrix hb col size and indexes
    t_long cshb = ((p_mobj->d_csiz >> ROW_RMHB_SHFT) & ROW_RMHB_MASK) + 1;
    // map the matrix row indexes
    t_long rihb = d_bihb / cshb;
    t_long rilt = d_bilt / COL_RMLT_SIZE;
    t_long rict = d_bict / COL_RMCT_SIZE;
    t_long ricc = d_bicc / COL_RMCC_SIZE;
    t_long ricb = d_bicb / COL_RMCB_SIZE;
    t_long rilb = d_bilb / COL_RMLB_SIZE;
    // recompute the row index
    t_long result = (rihb << ROW_RMHB_SHFT) + (rilt << ROW_RMLT_SHFT) +
                    (rict << ROW_RMCT_SHFT) + (ricc << ROW_RMCC_SHFT) +
                    (ricb << ROW_RMCB_SHFT) + rilb;
    return result;
  }

  // get the column coordinate at the iterator position (no lock)
  
  t_long Rmatrixit::getcol (void) const {
    // check for nil first
    if (p_mobj == nilp) return 0;
    // check valid indexes
    if ((d_bihb < 0) || (d_bihb >= d_hbsz)) {
      throw Exception ("internal-error", "invalid hb index in getcol");
    }
    // check valid indexes
    if ((d_bilt < 0) || (d_bilt >= BLK_RMLT_SIZE)) {
      throw Exception ("internal-error", "invalid lt index in getcol");
    }
    if ((d_bict < 0) || (d_bict >= BLK_RMCT_SIZE)) {
      throw Exception ("internal-error", "invalid ct index in getcol");
    }
    if ((d_bicc < 0) || (d_bicc >= BLK_RMCC_SIZE)) {
      throw Exception ("internal-error", "invalid cc index in getcol");
    }
    if ((d_bicb < 0) || (d_bicb >= BLK_RMCB_SIZE)) {
      throw Exception ("internal-error", "invalid cb index in getcol");
    }
    if ((d_bilb < 0) || (d_bilb >= BLK_RMLB_SIZE)) {
      throw Exception ("internal-error", "invalid lb index in getcol");
    }
    // map the matrix hb col size and indexes
    t_long cshb = ((p_mobj->d_csiz >> ROW_RMHB_SHFT) & ROW_RMHB_MASK) + 1;
    // map the matrix column indexes
    t_long cihb = d_bihb % cshb;
    t_long cilt = d_bilt % COL_RMLT_SIZE;
    t_long cict = d_bict % COL_RMCT_SIZE;
    t_long cicc = d_bicc % COL_RMCC_SIZE;
    t_long cicb = d_bicb % COL_RMCB_SIZE;
    t_long cilb = d_bilb % COL_RMLB_SIZE;
    // recompute the column index
    t_long result = (cihb << COL_RMHB_SHFT) + (cilt << COL_RMLT_SHFT) +
                    (cict << COL_RMCT_SHFT) + (cicc << COL_RMCC_SHFT) +
                    (cicb << COL_RMCB_SHFT) + cilb;
    return result;
  }

  // get the value at the current position (no lock)

  t_real Rmatrixit::getval (void) const {
    // check valid hb index
    if ((d_bihb < 0) || (d_bihb >= d_hbsz)) return 0.0;
    // map the rmlt array
    Rmatrix::t_rmlt rmlt = p_mobj->p_rmhb[d_bihb];
    // check for valid block and rmlt index
    if ((rmlt == nilp) || (d_bilt < 0) || (d_bilt >= BLK_RMLT_SIZE)) return 0.0;
    // map the rmct array
    Rmatrix::t_rmct rmct = rmlt[d_bilt];
    // check for valid block and rmct index
    if ((rmct == nilp) || (d_bict < 0) || (d_bict >= BLK_RMCT_SIZE)) return 0.0;
    // map the rmcc array
    Rmatrix::t_rmcc rmcc = rmct[d_bict];
    // check for valid block and rmcc index
    if ((rmcc == nilp) || (d_bicc < 0) || (d_bicc >= BLK_RMCC_SIZE)) return 0.0;
    // map the rmcb array
    Rmatrix::t_rmcb rmcb = rmcc[d_bicc];
    // check for valid block and rmcb index
    if ((rmcb == nilp) || (d_bicb < 0) || (d_bicb >= BLK_RMCB_SIZE)) return 0.0;
    // map the rmlb array
    Rmatrix::t_rmlb rmlb = rmcb[d_bicb];
    // check for valid block and rmlb index
    if ((rmlb == nilp) || (d_bilb < 0) || (d_bilb >= BLK_RMLB_SIZE)) return 0.0;
    // here it is
    return rmlb[d_bilb];
  }
}
