// ---------------------------------------------------------------------------
// - MthCalls.cpp                                                            -
// - afnix:mth module - math specific calls 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-2011 amaury darsch                                   -
// ---------------------------------------------------------------------------

#include "Cons.hpp"
#include "Real.hpp"
#include "Vector.hpp"
#include "Cramer.hpp"
#include "Krylov.hpp"
#include "Algebra.hpp"
#include "MthCalls.hpp"
#include "Exception.hpp"

namespace afnix {

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

  // compute the determinant of a matrix by direction

  Object* mth_det (Runnable* robj, Nameset* nset, Cons* args) {
    // get the arguments
    Vector* argv = Vector::eval (robj, nset, args);
    long    argc = (argv == nilp) ? 0 : argv->length ();
    try {
      // check for 1 argument
      if (argc != 1) {
	throw Exception ("argument-error", "too many argument with det");
      }
      // extract arguments
      Rmi* mp = dynamic_cast <Rmi*> (argv->get (0));
      // check for validity
      if (mp == nilp) {
 	throw Exception ("type-error", "invalid argument with det");
      }
      // compute the determinant
      Cramer cs (*mp);
      t_real result = cs.det ();
      delete argv; argv = nilp;
      return new Real (result);
    } catch (...) {
      delete argv;
      throw;
    }
  }

  // solve a linear system with the cramer method

  Object* mth_crm (Runnable* robj, Nameset* nset, Cons* args) {
    // get the arguments
    Vector* argv = Vector::eval (robj, nset, args);
    long    argc = (argv == nilp) ? 0 : argv->length ();
    Rvi*      ro = nilp;
    try {
      // check for 2 arguments
      if (argc != 2) {
	throw Exception ("argument-error", "too many argument with crm");
      }
      // extract arguments
      Rmi* mo = dynamic_cast <Rmi*> (argv->get (0));
      Rvi* vo = dynamic_cast <Rvi*> (argv->get (1));
      // check for validity
      if ((mo == nilp) || (vo == nilp)) {
 	throw Exception ("type-error", "invalid argument with crm");
      }
      // create a result vector
      ro = dynamic_cast <Rvi*> (vo->clone ()); ro->clear ();
      // solve the system
      if (Cramer::solve (*ro, *mo, *vo) == false) {
	throw Exception ("cramer-error", "linear system solver failure");
      }
      delete argv; argv = nilp;
      return ro;
    } catch (...) {
      delete ro;
      delete argv;
      throw;
    }
  }

  // solve a linear system with the cgs algorithm

  Object* mth_cgs (Runnable* robj, Nameset* nset, Cons* args) {
    // get the arguments
    Vector* argv = Vector::eval (robj, nset, args);
    long    argc = (argv == nilp) ? 0 : argv->length ();
    Rvi*      ro = nilp;
    try {
      // check for 3 or 4 arguments
      if ((argc < 3) && (argc > 4)) {
	throw Exception ("argument-error", "too many argument with cgs");
      }
      // arguments index
      long bi = (argc == 4) ? 2 : 1;
      long ii = (argc == 4) ? 3 : 2;
      // extract arguments
      Rmi* ao = dynamic_cast <Rmi*> (argv->get (0));
      Rvi* mo = (argc == 4) ? dynamic_cast <Rvi*> (argv->get (1)) : nilp;
      Rvi* bo = dynamic_cast <Rvi*> (argv->get (bi));
      long ni = argv->getlong (ii);
      // check for validity
      if ((ao == nilp) || (bo == nilp)) {
 	throw Exception ("type-error", "invalid argument with cgs");
      }
      if ((argc == 4) && (mo == nilp)) {
 	throw Exception ("type-error", "invalid argument with cgs");
      }
      // create a result vector
      ro = dynamic_cast <Rvi*> (bo->clone ()); ro->clear ();
      // solve the system
      if ((argc == 3) && (Krylov::cgs (*ro, *ao, *bo, ni) == false)) {
	throw Exception ("krylov-error", "cgs convergence failure");
      }
      if ((argc == 4) && (Krylov::cgs (*ro, *ao, *mo, *bo, ni) == false)) {
	throw Exception ("krylov-error", "cgs convergence failure");
      }
      delete argv; argv = nilp;
      return ro;
    } catch (...) {
      delete ro;
      delete argv;
      throw;
    }
  }

  // solve a linear system with the bcs algorithm

  Object* mth_bcs (Runnable* robj, Nameset* nset, Cons* args) {
    // get the arguments
    Vector* argv = Vector::eval (robj, nset, args);
    long    argc = (argv == nilp) ? 0 : argv->length ();
    Rvi*      ro = nilp;
    try {
      // check for 3 or 4 arguments
      if ((argc < 3) && (argc > 4)) {
	throw Exception ("argument-error", "too many argument with bcs");
      }
      // arguments index
      long bi = (argc == 4) ? 2 : 1;
      long ii = (argc == 4) ? 3 : 2;
      // extract arguments
      Rmi* ao = dynamic_cast <Rmi*> (argv->get (0));
      Rvi* mo = (argc == 4) ? dynamic_cast <Rvi*> (argv->get (1)) : nilp;
      Rvi* bo = dynamic_cast <Rvi*> (argv->get (bi));
      long ni = argv->getlong (ii);
      // check for validity
      if ((ao == nilp) || (bo == nilp)) {
 	throw Exception ("type-error", "invalid argument with bcs");
      }
      if ((argc == 4) && (mo == nilp)) {
 	throw Exception ("type-error", "invalid argument with bcs");
      }
      // create a result vector
      ro = dynamic_cast <Rvi*> (bo->clone ()); ro->clear ();
      // solve the system
      if ((argc == 3) && (Krylov::bcs (*ro, *ao, *bo, ni) == false)) {
	throw Exception ("krylov-error", "bcs convergence failure");
      }
      if ((argc == 4) && (Krylov::bcs (*ro, *ao, *mo, *bo, ni) == false)) {
	throw Exception ("krylov-error", "bcs convergence failure");
      }
      delete argv; argv = nilp;
      return ro;
    } catch (...) {
      delete ro;
      delete argv;
      throw;
    }
  }
}
