/*
  eigen.c
  Ruby/GSL: Ruby extension library for GSL (GNU Scientific Library)
    (C) Copyright 2001-2004 by Yoshiki Tsunesada

  Ruby/GSL is free software: you can redistribute it and/or modify it
  under the terms of the GNU General Public License.
  This library is distributed in the hope that it will be useful, but
  WITHOUT ANY WARRANTY.
*/

#include "rb_gsl.h"
#include "rb_gsl_array.h"

#include "rb_gsl_eigen.h"
#include "rb_gsl_complex.h"
#include <gsl/gsl_complex.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_eigen.h>

static VALUE cgsl_eigen_symm_workspace;
static VALUE cgsl_eigen_symmv_workspace;
static VALUE cgsl_eigen_herm_workspace;
static VALUE cgsl_eigen_hermv_workspace;
static VALUE cgsl_eigen_values;
static VALUE cgsl_eigen_vectors;
static VALUE cgsl_eigen_vector;
static VALUE cgsl_eigen_vector_complex;
static VALUE cgsl_eigen_herm_vectors;

static VALUE rb_gsl_eigen_symm_new(VALUE klass, VALUE nn)
{
  gsl_eigen_symm_workspace *w = NULL;
  CHECK_FIXNUM(nn);
  w = gsl_eigen_symm_alloc(FIX2INT(nn));
  return Data_Wrap_Struct(klass, 0, 
			  gsl_eigen_symm_free, w);
}

static VALUE rb_gsl_eigen_symmv_new(VALUE klass, VALUE nn)
{
  gsl_eigen_symmv_workspace *w = NULL;
  CHECK_FIXNUM(nn);
  w = gsl_eigen_symmv_alloc(FIX2INT(nn));
  return Data_Wrap_Struct(klass, 0, gsl_eigen_symmv_free, w);
}

static VALUE rb_gsl_eigen_herm_new(VALUE klass, VALUE nn)
{
  gsl_eigen_herm_workspace *w = NULL;
  CHECK_FIXNUM(nn);
  w = gsl_eigen_herm_alloc(FIX2INT(nn));
  return Data_Wrap_Struct(klass, 0, 
			  gsl_eigen_herm_free, w);
}

static VALUE rb_gsl_eigen_hermv_new(VALUE klass, VALUE nn)
{
  gsl_eigen_hermv_workspace *w = NULL;
  CHECK_FIXNUM(nn);
  w = gsl_eigen_hermv_alloc(FIX2INT(nn));
  return Data_Wrap_Struct(klass, 0, 
			  gsl_eigen_hermv_free, w);
}

static VALUE rb_gsl_eigen_symm(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix *Atmp = NULL, *A = NULL;
  gsl_eigen_symm_workspace *w = NULL;
  gsl_vector *v = NULL;
  int flagw = 0;
  switch (TYPE(obj)) {
  case T_MODULE:
  case T_CLASS:
  case T_OBJECT:
    switch (argc) {
    case 2:
      CHECK_MATRIX(argv[0]);
      Data_Get_Struct(argv[0], gsl_matrix, Atmp);
      if (CLASS_OF(argv[1]) != cgsl_eigen_symm_workspace)
	rb_raise(rb_eTypeError, "argv[1]: wrong argument type %s (Eigen::Symm::Workspace expected)", rb_class2name(CLASS_OF(argv[1])));
      Data_Get_Struct(argv[1], gsl_eigen_symm_workspace, w);
      break;
    case 1:
      CHECK_MATRIX(argv[0]);
      Data_Get_Struct(argv[0], gsl_matrix, Atmp);
      w = gsl_eigen_symm_alloc(Atmp->size1);
      flagw = 1;
      break;
    default:
      rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc);
    }
    break;
  default:
    CHECK_MATRIX(obj);
    Data_Get_Struct(obj, gsl_matrix, Atmp);
    switch (argc) {
    case 1:
      if (CLASS_OF(argv[0]) != cgsl_eigen_symm_workspace)
	rb_raise(rb_eTypeError, "argv[0]:  wrong argument type %s (Eigen::Symm::Workspace expected", rb_class2name(CLASS_OF(argv[0])));

      Data_Get_Struct(argv[0], gsl_eigen_symm_workspace, w);
      break;
    case 0:
      w = gsl_eigen_symm_alloc(Atmp->size1);
      flagw = 1;
      break;
    default:
      rb_raise(rb_eArgError, "wrong number of arguments (%d for 0 or 1)", argc);
    }
  }
  A = make_matrix_clone(Atmp);
  v = gsl_vector_alloc(A->size1);
  gsl_eigen_symm(A, v, w);
  /*  gsl_sort_vector(v);*/
  gsl_matrix_free(A);
  if (flagw == 1) gsl_eigen_symm_free(w);
  return Data_Wrap_Struct(cgsl_eigen_values, 0, gsl_vector_free, v);
}

static VALUE rb_gsl_eigen_symmv(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix *Atmp = NULL, *A = NULL, *em = NULL;
  gsl_eigen_symmv_workspace *w = NULL;
  gsl_vector *v = NULL;
  int flagw = 0;
  VALUE vval, vvec;
  switch (TYPE(obj)) {
  case T_MODULE:
  case T_CLASS:
  case T_OBJECT:
    switch (argc) {
    case 2:
      CHECK_MATRIX(argv[0]);
      Data_Get_Struct(argv[0], gsl_matrix, Atmp);
      if (CLASS_OF(argv[1]) != cgsl_eigen_symmv_workspace)
	rb_raise(rb_eTypeError, "argv[1]: wrong argument type %s (Eigen::Symmv::Workspace expected)", rb_class2name(CLASS_OF(argv[1])));
      Data_Get_Struct(argv[1], gsl_eigen_symmv_workspace, w);
      break;
    case 1:
      CHECK_MATRIX(argv[0]);
      Data_Get_Struct(argv[0], gsl_matrix, Atmp);
      w = gsl_eigen_symmv_alloc(Atmp->size1);
      flagw = 1;
      break;
    default:
      rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc);
    }
    break;
  default:
    CHECK_MATRIX(obj);
    Data_Get_Struct(obj, gsl_matrix, Atmp);
    switch (argc) {
    case 1:
      if (CLASS_OF(argv[0]) != cgsl_eigen_symmv_workspace)
	rb_raise(rb_eTypeError, "argv[0]: wrong argument type %s (Eigen::Symmv::Workspace expected)", rb_class2name(CLASS_OF(argv[0])));

      Data_Get_Struct(argv[0], gsl_eigen_symmv_workspace, w);
      break;
    case 0:
      w = gsl_eigen_symmv_alloc(Atmp->size1);
      flagw = 1;
      break;
    default:
      rb_raise(rb_eArgError, "wrong number of arguments (%d for 0 or 1)", argc);
      break;
    }
  }
  A = make_matrix_clone(Atmp);
  em = gsl_matrix_alloc(A->size1, A->size2);
  v = gsl_vector_alloc(A->size1);
  gsl_eigen_symmv(A, v, em, w);
  /*  gsl_eigen_symmv_sort(v, em, GSL_EIGEN_SORT_VAL_ASC);*/
  gsl_matrix_free(A);
  if (flagw == 1) gsl_eigen_symmv_free(w);
  vval = Data_Wrap_Struct(cgsl_eigen_values, 0, gsl_vector_free, v);
  vvec = Data_Wrap_Struct(cgsl_eigen_vectors, 0, gsl_matrix_free, em);
  return rb_ary_new3(2, vval, vvec);
}

static VALUE rb_gsl_eigen_herm(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix_complex *Atmp = NULL, *A = NULL;
  gsl_eigen_herm_workspace *w = NULL;
  gsl_vector *v = NULL;
  int flagw = 0;

  switch (TYPE(obj)) {
  case T_MODULE:
  case T_CLASS:
  case T_OBJECT:
    switch (argc) {
    case 2:
      CHECK_MATRIX_COMPLEX(argv[0]);
      Data_Get_Struct(argv[0], gsl_matrix_complex, Atmp);
      if (CLASS_OF(argv[1]) != cgsl_eigen_herm_workspace)
	rb_raise(rb_eTypeError, "argv[1]: wrong argument type %s (Eigen::Herm::Workspace expected)", rb_class2name(CLASS_OF(argv[1])));
      Data_Get_Struct(argv[1], gsl_eigen_herm_workspace, w);
      break;
    case 1:
      CHECK_MATRIX_COMPLEX(argv[0]);
      Data_Get_Struct(argv[0], gsl_matrix_complex, Atmp);
      w = gsl_eigen_herm_alloc(Atmp->size1);
      flagw = 1;
      break;
    default:
      rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc);
    }
    break;
  default:
    CHECK_MATRIX_COMPLEX(obj);
    Data_Get_Struct(obj, gsl_matrix_complex, Atmp);
    switch (argc) {
    case 1:
      if (CLASS_OF(argv[0]) != cgsl_eigen_herm_workspace)
	rb_raise(rb_eTypeError, "argv[0]: wrong argument type %s (Eigen::Herm::Workspace expected)", rb_class2name(CLASS_OF(argv[0])));

      Data_Get_Struct(argv[0], gsl_eigen_herm_workspace, w);
      break;
    case 0:
      w = gsl_eigen_herm_alloc(Atmp->size1);
      flagw = 1;
      break;
    default:
      rb_raise(rb_eArgError, "wrong number of arguments (%d for 0 or 1)", argc);
    }
  }
  A = make_matrix_complex_clone(Atmp);
  v = gsl_vector_alloc(A->size1);
  gsl_eigen_herm(A, v, w);
  /*  gsl_sort_vector(v);*/
  gsl_matrix_complex_free(A);
  if (flagw == 1) gsl_eigen_herm_free(w);
  return Data_Wrap_Struct(cgsl_eigen_values, 0, gsl_vector_free, v);
}

static VALUE rb_gsl_eigen_hermv(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix_complex *Atmp = NULL, *A = NULL, *em = NULL;
  gsl_eigen_hermv_workspace *w = NULL;
  gsl_vector *v = NULL;
  int flagw = 0;
  VALUE vval, vvec;
  switch (TYPE(obj)) {
  case T_MODULE:
  case T_CLASS:
  case T_OBJECT:
    switch (argc) {
    case 2:
      CHECK_MATRIX_COMPLEX(argv[0]);
      Data_Get_Struct(argv[0], gsl_matrix_complex, Atmp);
      if (CLASS_OF(argv[1]) != cgsl_eigen_hermv_workspace)
	rb_raise(rb_eTypeError, "argv[1]: wrong argument type %s (Eigen::Hermv::Workspace expected)", rb_class2name(CLASS_OF(argv[1])));
      Data_Get_Struct(argv[1], gsl_eigen_hermv_workspace, w);
      break;
    case 1:
      CHECK_MATRIX_COMPLEX(argv[0]);
      Data_Get_Struct(argv[0], gsl_matrix_complex, Atmp);
      w = gsl_eigen_hermv_alloc(Atmp->size1);
      flagw = 1;
      break;
    default:
      rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc);
    }
    break;
  default:
    CHECK_MATRIX_COMPLEX(obj);
    Data_Get_Struct(obj, gsl_matrix_complex, Atmp);
    switch (argc) {
    case 1:
      if (CLASS_OF(argv[0]) != cgsl_eigen_hermv_workspace)
	rb_raise(rb_eTypeError, "argv[0]: wrong argument type %s (Eigen::Hermv::Workspace expected)", rb_class2name(CLASS_OF(argv[0])));

      Data_Get_Struct(argv[0], gsl_eigen_hermv_workspace, w);
      break;
    case 0:
      w = gsl_eigen_hermv_alloc(Atmp->size1);
      flagw = 1;
      break;
    default:
      rb_raise(rb_eArgError, "wrong number of arguments (%d for 0 or 1)", argc);
    }
  }
  A = make_matrix_complex_clone(Atmp);
  em = gsl_matrix_complex_alloc(A->size1, A->size2);
  v = gsl_vector_alloc(A->size1);
  gsl_eigen_hermv(A, v, em, w);
  /*  gsl_eigen_hermv_sort(v, em, GSL_EIGEN_SORT_VAL_ASC);*/
  gsl_matrix_complex_free(A);
  if (flagw == 1) gsl_eigen_hermv_free(w);
  vval = Data_Wrap_Struct(cgsl_eigen_values, 0, gsl_vector_free, v);
  vvec = Data_Wrap_Struct(cgsl_eigen_herm_vectors, 0, gsl_matrix_complex_free, em);
  return rb_ary_new3(2, vval, vvec);
}

static VALUE rb_gsl_eigen_vectors_unpack(VALUE obj)
{
  gsl_matrix *m = NULL;
  gsl_vector *v = NULL;
  size_t i, j;
  double val;
  VALUE ary, tmp;
  Data_Get_Struct(obj, gsl_matrix, m);
  ary = rb_ary_new2(m->size1);
  for (i = 0; i < m->size1; i++) {
    v = gsl_vector_alloc(m->size2);
    for (j = 0; j < m->size2; j++) {
      val = gsl_matrix_get(m, j, i);
      gsl_vector_set(v, j, val);
    }
    tmp = Data_Wrap_Struct(cgsl_eigen_vector, 0, gsl_vector_free, v);
    rb_ary_store(ary, i, tmp);
  }
  return ary;
}

static VALUE rb_gsl_eigen_vectors_complex_unpack(VALUE obj)
{
  gsl_matrix_complex *m = NULL;
  gsl_vector_complex *v = NULL;
  size_t i, j;
  gsl_complex z;
  VALUE ary, tmp;
  Data_Get_Struct(obj, gsl_matrix_complex, m);
  ary = rb_ary_new2(m->size1);
  for (i = 0; i < m->size1; i++) {
    v = gsl_vector_complex_alloc(m->size2);
    for (j = 0; j < m->size2; j++) {
      z= gsl_matrix_complex_get(m, j, i);
      gsl_vector_complex_set(v, j, z);
    }
    tmp = Data_Wrap_Struct(cgsl_eigen_vector_complex, 0, gsl_vector_complex_free, v);
    rb_ary_store(ary, i, tmp);
  }
  return ary;
}

static void rb_gsl_eigen_define_const(VALUE module)
{
  rb_define_const(module, "SORT_VAL_ASC", INT2FIX(GSL_EIGEN_SORT_VAL_ASC));
  rb_define_const(module, "SORT_VAL_DESC", INT2FIX(GSL_EIGEN_SORT_VAL_DESC));
  rb_define_const(module, "SORT_ABS_ASC", INT2FIX(GSL_EIGEN_SORT_ABS_ASC));
  rb_define_const(module, "SORT_ABS_DESC", INT2FIX(GSL_EIGEN_SORT_ABS_DESC));

  rb_define_const(module, "VAL_ASC", INT2FIX(GSL_EIGEN_SORT_VAL_ASC));
  rb_define_const(module, "VAL_DESC", INT2FIX(GSL_EIGEN_SORT_VAL_DESC));
  rb_define_const(module, "ABS_ASC", INT2FIX(GSL_EIGEN_SORT_ABS_ASC));
  rb_define_const(module, "ABS_DESC", INT2FIX(GSL_EIGEN_SORT_ABS_DESC));
}

static VALUE rb_gsl_eigen_symmv_sort(int argc, VALUE *argv, VALUE obj)
{
  gsl_vector *v;
  gsl_matrix *m;
  gsl_eigen_sort_t type = GSL_EIGEN_SORT_VAL_ASC;
  switch (argc) {
  case 3:
    CHECK_FIXNUM(argv[2]);
    type = FIX2INT(argv[2]);
    /* no break, do next */
  case 2:
    CHECK_VECTOR(argv[0]); CHECK_MATRIX(argv[1]);
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 3)", argc);
  }
  Data_Get_Struct(argv[0], gsl_vector, v);
  Data_Get_Struct(argv[1], gsl_matrix, m);
 
  return INT2FIX(gsl_eigen_symmv_sort(v, m, type));
}

static VALUE rb_gsl_eigen_hermv_sort(int argc, VALUE *argv, VALUE obj)
{
  gsl_vector *v;
  gsl_matrix_complex *m;
  gsl_eigen_sort_t type = GSL_EIGEN_SORT_VAL_ASC;

  switch (argc) {
  case 3:
    CHECK_FIXNUM(argv[2]);
    type = FIX2INT(argv[2]);
    /* no break, do next */
  case 2:
    CHECK_VECTOR(argv[0]);
    CHECK_MATRIX_COMPLEX(argv[1]);
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 3)", argc);
  }
  Data_Get_Struct(argv[0], gsl_vector, v);
  Data_Get_Struct(argv[1], gsl_matrix_complex, m);  
  return INT2FIX(gsl_eigen_hermv_sort(v, m, type));
}


void Init_gsl_eigen(VALUE module)
{
  VALUE mgsl_eigen;
  VALUE mgsl_eigen_symm;
  VALUE mgsl_eigen_symmv;
  VALUE mgsl_eigen_herm;
  VALUE mgsl_eigen_hermv;

  mgsl_eigen = rb_define_module_under(module, "Eigen");
  mgsl_eigen_symm = rb_define_module_under(mgsl_eigen, "Symm");
  mgsl_eigen_symmv = rb_define_module_under(mgsl_eigen, "Symmv");
  mgsl_eigen_herm = rb_define_module_under(mgsl_eigen, "Herm");
  mgsl_eigen_hermv = rb_define_module_under(mgsl_eigen, "Hermv");
  cgsl_eigen_values = rb_define_class_under(mgsl_eigen, "EigenValues",
					    cgsl_vector);
  cgsl_eigen_vectors = rb_define_class_under(mgsl_eigen, "EigenVectors",
					    cgsl_matrix);
  cgsl_eigen_vector = rb_define_class_under(mgsl_eigen, "EigenVector",
					    cgsl_vector);
  cgsl_eigen_herm_vectors = rb_define_class_under(mgsl_eigen_herm, "EigenVectors",
						  cgsl_matrix_complex);
  cgsl_eigen_vector_complex = rb_define_class_under(mgsl_eigen_herm, "EigenVector",
						  cgsl_vector_complex);
  cgsl_eigen_symm_workspace = rb_define_class_under(mgsl_eigen_symm, 
						     "Workspace", rb_cObject);
  cgsl_eigen_symmv_workspace = rb_define_class_under(mgsl_eigen_symmv, 
						     "Workspace", rb_cObject);
  cgsl_eigen_herm_workspace = rb_define_class_under(mgsl_eigen_herm, 
						     "Workspace", rb_cObject);

   cgsl_eigen_hermv_workspace = rb_define_class_under(mgsl_eigen_hermv, 
						     "Workspace", rb_cObject);

  rb_define_singleton_method(cgsl_eigen_symm_workspace, "new", 
			     rb_gsl_eigen_symm_new, 1);
  rb_define_singleton_method(cgsl_eigen_symm_workspace, "alloc", 
			     rb_gsl_eigen_symm_new, 1);
  rb_define_singleton_method(cgsl_eigen_symmv_workspace, "new", 
			     rb_gsl_eigen_symmv_new, 1);
  rb_define_singleton_method(cgsl_eigen_symmv_workspace, "alloc", 
			     rb_gsl_eigen_symmv_new, 1);
  rb_define_singleton_method(cgsl_eigen_herm_workspace, "new", 
			     rb_gsl_eigen_herm_new, 1);
  rb_define_singleton_method(cgsl_eigen_herm_workspace, "alloc", 
			     rb_gsl_eigen_herm_new, 1);
  rb_define_singleton_method(cgsl_eigen_hermv_workspace, "new", 
			     rb_gsl_eigen_hermv_new, 1);
  rb_define_singleton_method(cgsl_eigen_hermv_workspace, "alloc", 
			     rb_gsl_eigen_hermv_new, 1);

  rb_define_singleton_method(mgsl_eigen, "symm",
			     rb_gsl_eigen_symm, -1);
  rb_define_singleton_method(mgsl_eigen, "symmv",
			     rb_gsl_eigen_symmv, -1);
  rb_define_singleton_method(mgsl_eigen, "herm",
			     rb_gsl_eigen_herm, -1);
  rb_define_singleton_method(mgsl_eigen, "herm",
			     rb_gsl_eigen_hermv, -1);

  rb_define_method(cgsl_matrix, "eigen_symm", rb_gsl_eigen_symm, -1);
  rb_define_method(cgsl_matrix, "eigen_symmv", rb_gsl_eigen_symmv, -1);
  rb_define_method(cgsl_matrix_complex, "eigen_herm", rb_gsl_eigen_herm, -1);
  rb_define_method(cgsl_matrix_complex, "eigen_hermv", rb_gsl_eigen_hermv, -1);

  rb_define_method(cgsl_eigen_vectors, "unpack", rb_gsl_eigen_vectors_unpack, 0);
  rb_define_method(cgsl_eigen_herm_vectors, "unpack", rb_gsl_eigen_vectors_complex_unpack, 0);

  rb_gsl_eigen_define_const(mgsl_eigen);

  rb_define_singleton_method(mgsl_eigen, "symmv_sort", 
			     rb_gsl_eigen_symmv_sort, -1);
  rb_define_singleton_method(mgsl_eigen, "hermv_sort", 
			     rb_gsl_eigen_hermv_sort, -1);
  rb_define_singleton_method(mgsl_eigen_symmv, "sort", 
			     rb_gsl_eigen_symmv_sort, -1);
  rb_define_singleton_method(mgsl_eigen_hermv, "sort", 
			     rb_gsl_eigen_hermv_sort, -1);
}

