/*
  multifit.c
  Ruby/GSL: Ruby extension library for GSL (GNU Scientific Library)
    (C) Copyright 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_fit.h"
#include "rb_gsl_function.h"

#ifndef CHECK_WORKSPACE
#define CHECK_WORKSPACE(x) if(CLASS_OF(x)!=cgsl_multifit_workspace)\
      rb_raise(rb_eTypeError,\
      "wrong argument type %s (MultiFit::Workspace expected)",\
      rb_class2name(CLASS_OF(x)));
#endif

#ifndef CHECK_FUNCTION_FDF
#define CHECK_FUNCTION_FDF(x) if(CLASS_OF(x)!=cgsl_multifit_function_fdf)\
      rb_raise(rb_eTypeError,\
      "wrong argument type %s (MultiFit::Workspace expected)",\
      rb_class2name(CLASS_OF(x)));
#endif

static VALUE cgsl_multifit_workspace;
static VALUE cgsl_multifit_function_fdf;

enum MultiFit_Solver_Type{
  GSL_MULTIFIT_FDFSOLVER_LMSDER,
  GSL_MULTIFIT_FDFSOLVER_LMDER,
};

static VALUE rb_gsl_multifit_workspace_new(VALUE klass, VALUE n, VALUE p)
{
  gsl_multifit_linear_workspace *w = NULL;
  CHECK_FIXNUM(n); CHECK_FIXNUM(p);
  w = gsl_multifit_linear_alloc(FIX2INT(n), FIX2INT(p));
  return Data_Wrap_Struct(klass, 0, gsl_multifit_linear_free, w);
}

static VALUE rb_gsl_multifit_linear(int argc, VALUE *argv, VALUE obj)
{
  gsl_multifit_linear_workspace *space = NULL;
  gsl_matrix *x = NULL, *cov = NULL;
  gsl_vector *y = NULL, *c = NULL;
  double chisq;
  int status, flag = 0;
  VALUE vc, vcov;
  if (argc != 2 && argc != 3) 
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 3)", argc);
  CHECK_MATRIX(argv[0]);
  CHECK_VECTOR(argv[1]);
  Data_Get_Struct(argv[0], gsl_matrix, x);
  Data_Get_Struct(argv[1], gsl_vector, y);
  if (argc == 3) {
    CHECK_WORKSPACE(argv[2]);
    Data_Get_Struct(argv[2], gsl_multifit_linear_workspace, space);
  } else {
    space = gsl_multifit_linear_alloc(x->size1, x->size2);
    flag = 1;
  }
  cov = gsl_matrix_alloc(x->size1, x->size2);
  c = gsl_vector_alloc(y->size);
  status = gsl_multifit_linear(x, y, c, cov, &chisq, space);
  if (flag == 1) gsl_multifit_linear_free(space);
  vc = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, c);
  vcov = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, cov);
  return rb_ary_new3(4, vc, vcov, rb_float_new(chisq), INT2FIX(status));
}

static VALUE rb_gsl_multifit_wlinear(int argc, VALUE *argv, VALUE obj)
{
  gsl_multifit_linear_workspace *space = NULL;
  gsl_matrix *x = NULL, *cov = NULL;
  gsl_vector *w = NULL, *y = NULL, *c = NULL;
  double chisq;
  int status, flag = 0;
  VALUE vc, vcov;
  if (argc != 3 && argc != 4) 
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 3 or 4)", argc);
  CHECK_MATRIX(argv[0]);
  CHECK_VECTOR(argv[1]); CHECK_VECTOR(argv[2]);
  Data_Get_Struct(argv[0], gsl_matrix, x);
  Data_Get_Struct(argv[1], gsl_vector, w);
  Data_Get_Struct(argv[2], gsl_vector, y);
  if (argc == 4) {
    CHECK_WORKSPACE(argv[3]);
    Data_Get_Struct(argv[3], gsl_multifit_linear_workspace, space);
  } else {
    space = gsl_multifit_linear_alloc(x->size1, x->size2);
    flag = 1;
  }
  cov = gsl_matrix_alloc(x->size2, x->size2);
  c = gsl_vector_alloc(x->size2);
  status = gsl_multifit_linear(x, y, c, cov, &chisq, space);
  if (flag == 1) gsl_multifit_linear_free(space);
  vc = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, c);
  vcov = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, cov);
  return rb_ary_new3(4, vc, vcov, rb_float_new(chisq), INT2FIX(status));
}

static VALUE rb_gsl_multifit_fdfsolver_new(int argc, VALUE *argv, VALUE klass)
{
  const gsl_multifit_fdfsolver_type *T;
  gsl_multifit_fdfsolver *solver = NULL;
  size_t n, p;
  char name[64];
  switch (argc) {
  case 3:
    switch (TYPE(argv[0])) {
    case T_STRING:
      strcpy(name, STR2CSTR(argv[0]));
      if (str_tail_grep(name, "lmsder") == 0) {
	T = gsl_multifit_fdfsolver_lmsder;
      } else if (str_tail_grep(name, "lmder") == 0) {
	T = gsl_multifit_fdfsolver_lmder;
      } else {
	rb_raise(rb_eTypeError, "unknown solver type %s (lmsder of lmder)",
		 name);
      }
      break;
    case T_FIXNUM:
      switch (FIX2INT(argv[0])) {
      case GSL_MULTIFIT_FDFSOLVER_LMSDER:
	T = gsl_multifit_fdfsolver_lmsder;
	break;
      case GSL_MULTIFIT_FDFSOLVER_LMDER:
	T = gsl_multifit_fdfsolver_lmder;
	break;
      default:
	rb_raise(rb_eTypeError, "unknown solver type (GSL::MultiFit::FdfSolver::LMSDER or LMDER expected)");
	break;
      }
      break;
    default:
      rb_raise(rb_eTypeError, "wrong argument type (Fixnum or String)",
	       rb_class2name(CLASS_OF(argv[0])));
      break;
    }
    CHECK_FIXNUM(argv[1]); CHECK_FIXNUM(argv[2]);
    n = FIX2INT(argv[1]);
    p = FIX2INT(argv[2]);
    break;
  case 2:
    CHECK_FIXNUM(argv[0]); CHECK_FIXNUM(argv[1]);
    T = gsl_multifit_fdfsolver_lmsder;
    n = FIX2INT(argv[0]);
    p = FIX2INT(argv[1]);
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments");
    break;
  }
  solver = gsl_multifit_fdfsolver_alloc(T, n, p);
  return Data_Wrap_Struct(klass, 0, gsl_multifit_fdfsolver_free, solver);
}

static VALUE rb_gsl_multifit_fdfsolver_set(VALUE obj, VALUE ff, VALUE xx)
{
  gsl_multifit_fdfsolver *solver = NULL;
  gsl_multifit_function_fdf *f = NULL;
  gsl_vector *x = NULL;
  int status;
  CHECK_VECTOR(xx);
  CHECK_FUNCTION_FDF(ff);
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  Data_Get_Struct(ff, gsl_multifit_function_fdf, f);
  Data_Get_Struct(xx, gsl_vector, x);
  status = gsl_multifit_fdfsolver_set(solver, f, x);
  return INT2FIX(status);
}

static VALUE rb_gsl_multifit_fdfsolver_name(VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  return rb_str_new2(gsl_multifit_fdfsolver_name(solver));
}

static VALUE rb_gsl_multifit_fdfsolver_iterate(VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  return INT2FIX(gsl_multifit_fdfsolver_iterate(solver));
}

static VALUE rb_gsl_multifit_fdfsolver_position(VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  gsl_vector *x = NULL;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  x = gsl_multifit_fdfsolver_position(solver);
  return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, x);
}

static VALUE rb_gsl_multifit_fdfsolver_print_state(VALUE obj, VALUE i)
{
  gsl_multifit_fdfsolver *solver = NULL;
  CHECK_FIXNUM(i);
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  printf("iter: %3d x = %15.8f %15.8f %15.8f |f(x)| = %g\n",
	 FIX2INT(i), gsl_vector_get(solver->x, 0), gsl_vector_get(solver->x, 1),
	 gsl_vector_get(solver->x, 2), gsl_blas_dnrm2(solver->f));
  return Qtrue;
}

static VALUE rb_gsl_multifit_fdfsolver_fdf(VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  return Data_Wrap_Struct(cgsl_multifit_function_fdf, 0, NULL, solver->fdf);
}

static VALUE rb_gsl_multifit_fdfsolver_test_delta(VALUE obj, VALUE r, VALUE a)
{
  gsl_multifit_fdfsolver *solver = NULL;
  Need_Float(r); Need_Float(a);
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  return INT2FIX(gsl_multifit_test_delta(solver->dx, solver->x, NUM2DBL(r), NUM2DBL(a)));
}

static VALUE rb_gsl_multifit_fdfsolver_test_gradient(int argc, VALUE *argv, VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  gsl_vector *g = NULL;
  int status;
  double epsabs;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  switch (argc) {
  case 1:
    Need_Float(argv[0]);
    g = gsl_vector_alloc(solver->x->size);
    gsl_multifit_gradient(solver->J, solver->f, g);
    epsabs = NUM2DBL(argv[0]);
    status = gsl_multifit_test_gradient(g, epsabs);
    gsl_vector_free(g);
    break;
  case 2:
    CHECK_VECTOR(argv[0]);
    Need_Float(argv[1]);
    Data_Get_Struct(argv[0], gsl_vector, g);
    epsabs = NUM2DBL(argv[1]);
    status = gsl_multifit_test_gradient(g, epsabs);
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments");
    break;
  }
  return INT2FIX(status);
}

static VALUE rb_gsl_multifit_fdfsolver_gradient(int argc, VALUE *argv, VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  gsl_vector *g = NULL;
  int status;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  if (argc == 1) {
    CHECK_VECTOR(argv[0]);
    Data_Get_Struct(argv[0], gsl_vector, g);
    return INT2FIX(gsl_multifit_gradient(solver->J, solver->f, g));
  } else {
    g = gsl_vector_alloc(solver->x->size);
    status = gsl_multifit_gradient(solver->J, solver->f, g);
    return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, g);
  }
}

static VALUE rb_gsl_multifit_fdfsolver_covar(int argc, VALUE *argv, VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  gsl_matrix *covar = NULL;
  double epsrel;
  int status;
  if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
  Need_Float(argv[0]);
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  epsrel = NUM2DBL(argv[0]);
  switch (argc) {
  case 1:
    covar = gsl_matrix_alloc(solver->x->size, solver->x->size);
    status = gsl_multifit_covar(solver->J, epsrel, covar);
    return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, covar);
    break;
  case 2:
    CHECK_MATRIX(argv[1]);
    Data_Get_Struct(argv[1], gsl_matrix, covar);
    return INT2FIX(gsl_multifit_covar(solver->J, epsrel, covar));
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments");
    break;
  }
}

static VALUE rb_gsl_multifit_fdfsolver_x(VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, solver->x);
}

static VALUE rb_gsl_multifit_fdfsolver_dx(VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, solver->dx);
}

static VALUE rb_gsl_multifit_fdfsolver_f(VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, solver->f);
}

static VALUE rb_gsl_multifit_fdfsolver_J(VALUE obj)
{
  gsl_multifit_fdfsolver *solver = NULL;
  Data_Get_Struct(obj, gsl_multifit_fdfsolver, solver);
  return Data_Wrap_Struct(cgsl_matrix_view_ro, 0, NULL, solver->J);
}

static VALUE rb_gsl_multifit_test_delta(VALUE obj, VALUE ddx, VALUE xx, VALUE a, VALUE r)
{
  gsl_vector *dx = NULL, *x = NULL;
  CHECK_VECTOR(ddx);
  CHECK_VECTOR(xx);
  Need_Float(a); Need_Float(r);
  Data_Get_Struct(ddx, gsl_vector, dx);
  Data_Get_Struct(xx, gsl_vector, x);
  return INT2FIX(gsl_multifit_test_delta(dx, x, NUM2DBL(a), NUM2DBL(r)));
}

static VALUE rb_gsl_multifit_test_gradient(VALUE obj, VALUE gg, VALUE a)
{
  gsl_vector *g = NULL;
  CHECK_VECTOR(gg);
  Need_Float(a);
  Data_Get_Struct(gg, gsl_vector, g);
  return INT2FIX(gsl_multifit_test_gradient(g, NUM2DBL(a)));
}

static VALUE rb_gsl_multifit_gradient(int argc, VALUE *argv, VALUE obj)
{
  gsl_vector *g = NULL, *f = NULL;
  gsl_matrix *J = NULL;
  int status;
  switch (argc) {
  case 2:
    CHECK_MATRIX(argv[0]);
    CHECK_VECTOR(argv[1]);
    Data_Get_Struct(argv[0], gsl_matrix, J);
    Data_Get_Struct(argv[1], gsl_vector, f);  
    g = gsl_vector_alloc(f->size);
    status = gsl_multifit_gradient(J, f, g);
    return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, g);
    break;  
  case 3:
    CHECK_MATRIX(argv[0]);
    CHECK_VECTOR(argv[1]);
    CHECK_VECTOR(argv[2]);
    Data_Get_Struct(argv[0], gsl_matrix, J);
    Data_Get_Struct(argv[1], gsl_vector, f);  
    Data_Get_Struct(argv[2], gsl_vector, g);  
    return INT2FIX(gsl_multifit_gradient(J, f, g));
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments");
    break;
  }
}

static VALUE rb_gsl_multifit_covar(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix *J = NULL, *covar = NULL;
  double epsrel;
  int status;
  switch (argc) {
  case 2:
    CHECK_MATRIX(argv[0]);
    Need_Float(argv[1]);
    Data_Get_Struct(argv[0], gsl_matrix, J);
    epsrel = NUM2DBL(argv[1]);
    covar = gsl_matrix_alloc(J->size2, J->size2);
    status = gsl_multifit_covar(J, epsrel, covar);
    return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, covar);
    break;
  case 3:
    CHECK_MATRIX(argv[0]);
    Need_Float(argv[1]);
    CHECK_MATRIX(argv[2]);
    Data_Get_Struct(argv[0], gsl_matrix, J);
    epsrel = NUM2DBL(argv[1]);
    Data_Get_Struct(argv[2], gsl_matrix, covar);
    status = gsl_multifit_covar(J, epsrel, covar);
    return INT2FIX(status);
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments");
    break;
  }
}

static void rb_gsl_multifit_define_const(VALUE klass)
{
  rb_define_const(klass, "LMSDER", 
		  INT2FIX(GSL_MULTIFIT_FDFSOLVER_LMSDER));
  rb_define_const(klass, "LMDER", 
		  INT2FIX(GSL_MULTIFIT_FDFSOLVER_LMDER));

  rb_define_const(klass, "Lmsder", 
		  INT2FIX(GSL_MULTIFIT_FDFSOLVER_LMSDER));
  rb_define_const(klass, "Lmder", 
		  INT2FIX(GSL_MULTIFIT_FDFSOLVER_LMDER));
}

static void gsl_multifit_function_fdf_free(gsl_multifit_function_fdf *f);
static void gsl_multifit_function_fdf_free(gsl_multifit_function_fdf *f)
{
  free((gsl_multifit_function_fdf *) f);
}

static void gsl_multifit_function_fdf_mark(gsl_multifit_function_fdf *F);
static void gsl_multifit_function_fdf_mark(gsl_multifit_function_fdf *F)
{
  rb_gc_mark((VALUE) F->params);
}

static int gsl_multifit_function_fdf_f(const gsl_vector *x, void *params,
				       gsl_vector *f);
static int gsl_multifit_function_fdf_df(const gsl_vector *x, void *params,
					gsl_matrix *J);
static int gsl_multifit_function_fdf_fdf(const gsl_vector *x, void *params,
					 gsl_vector *f, gsl_matrix *J);

static VALUE rb_gsl_multifit_function_fdf_set_procs(int argc, VALUE *argv, VALUE obj);

static VALUE rb_gsl_multifit_function_fdf_new(int argc, VALUE *argv, VALUE klass)
{
  gsl_multifit_function_fdf *func = NULL;
  VALUE obj;
  func = ALLOC(gsl_multifit_function_fdf);
  func->f = &gsl_multifit_function_fdf_f;
  func->df = &gsl_multifit_function_fdf_df;
  func->fdf = &gsl_multifit_function_fdf_fdf;
  func->params = NULL;
  obj = Data_Wrap_Struct(klass, gsl_multifit_function_fdf_mark, gsl_multifit_function_fdf_free, func);
  switch (argc) {
  case 0:
  case 1:
    break;
  case 2:
  case 3:
    rb_gsl_multifit_function_fdf_set_procs(argc, argv, obj);
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 0-3)", argc);
    break;
  }
  return obj;
}			    

static VALUE rb_gsl_multifit_function_fdf_set_procs(int argc, VALUE *argv, VALUE obj)
{
  gsl_multifit_function_fdf *func = NULL;
  VALUE ary;
  Data_Get_Struct(obj, gsl_multifit_function_fdf, func);
  if (func->params == NULL) {
    ary = rb_ary_new2(4);
    (VALUE) func->params = ary;
  } else {
    ary = (VALUE) func->params;
  }
  rb_ary_store(ary, 0, argv[0]);
  rb_ary_store(ary, 1, argv[1]);
  switch (argc) {
  case 3:
    if (TYPE(argv[2]) == T_FIXNUM) {
      func->p = FIX2INT(argv[2]);
      rb_ary_store(ary, 2, Qnil);
    } else rb_ary_store(ary, 2, argv[2]);
    break;
  case 4:
    if (TYPE(argv[2]) == T_FIXNUM) {
      func->p = FIX2INT(argv[2]);
      rb_ary_store(ary, 2, argv[3]);
    } else {
      func->p = FIX2INT(argv[3]);
      rb_ary_store(ary, 2, argv[2]);
    }
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 3 or 4)", argc);
    break;
  }
  return obj;
}

static VALUE rb_gsl_multifit_function_fdf_set_data(int argc, VALUE *argv, VALUE obj)
{
  VALUE ary, ary2;
  gsl_multifit_function_fdf *func = NULL;
  gsl_vector *v = NULL;
  Data_Get_Struct(obj, gsl_multifit_function_fdf, func);
  if (func->params == NULL) {
    ary = rb_ary_new2(4);
    (VALUE) func->params = ary;
  } else {
    ary = (VALUE) func->params;
  }
  switch (argc) {
  case 2:
    ary2 = rb_ary_new3(2, argv[0], argv[1]);  /* t, y */
    break;
  case 3:
    ary2 = rb_ary_new3(3, argv[0], argv[1], argv[2]);  /* t, y, sigma */
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 3)", argc);
    break;
  }
  CHECK_VECTOR(argv[0]);
  Data_Get_Struct(argv[0], gsl_vector, v);
  func->n = v->size;
  rb_ary_store(ary, 3, ary2);
  return obj;
}

static int gsl_multifit_function_fdf_f(const gsl_vector *x, void *params,
				       gsl_vector *f)
{
  VALUE vt_y_sigma, vt, vy, vsigma, vf, vx, proc, ary;
  ary = (VALUE) params;
  vt_y_sigma = rb_ary_entry(ary, 3);
  proc = rb_ary_entry(ary, 0);
  vx = Data_Wrap_Struct(cgsl_vector, 0, NULL, (gsl_vector *) x);
  vf = Data_Wrap_Struct(cgsl_vector, 0, NULL, f);
  switch (RARRAY(vt_y_sigma)->len) {
  case 2:
    vt = rb_ary_entry(vt_y_sigma, 0);
    vy = rb_ary_entry(vt_y_sigma, 1);
    rb_funcall(proc, ID_call, 4, vx, vt, vy, vf);
    break;
  case 3:
    vt = rb_ary_entry(vt_y_sigma, 0);
    vy = rb_ary_entry(vt_y_sigma, 1);
    vsigma = rb_ary_entry(vt_y_sigma,2);
    rb_funcall(proc, ID_call, 5, vx, vt, vy, vsigma, vf);
    break;
  default:
    rb_raise(rb_eArgError, "bad argument");
    break;    
  }
  return GSL_SUCCESS;
}

static int gsl_multifit_function_fdf_df(const gsl_vector *x, void *params,
					gsl_matrix *J)
{
  VALUE vt_y_sigma, vt, vy, vsigma, vJ, vx, proc, ary;
  ary = (VALUE) params;
  vt_y_sigma = rb_ary_entry(ary, 3);
  proc = rb_ary_entry(ary, 1);
  vx = Data_Wrap_Struct(cgsl_vector, 0, NULL, (gsl_vector *) x);
  vJ = Data_Wrap_Struct(cgsl_matrix, 0, NULL, J);
  switch (RARRAY(vt_y_sigma)->len) {
  case 2:
    vt = rb_ary_entry(vt_y_sigma, 0);
    vy = rb_ary_entry(vt_y_sigma, 1);
    rb_funcall(proc, ID_call, 4, vx, vt, vy, vJ);
    break;
  case 3:
    vt = rb_ary_entry(vt_y_sigma, 0);
    vy = rb_ary_entry(vt_y_sigma, 1);
    vsigma = rb_ary_entry(vt_y_sigma,2);
    rb_funcall(proc, ID_call, 5, vx, vt, vy, vsigma, vJ);
    break;
  default:
    rb_raise(rb_eArgError, "bad argument");
    break;    
  }
  return GSL_SUCCESS;
}

static int gsl_multifit_function_fdf_fdf(const gsl_vector *x, void *params,
					 gsl_vector *f, gsl_matrix *J)
{
  VALUE vt_y_sigma, vt, vy, vsigma, vf, vJ, vx, proc_f, proc_df, proc_fdf;
  VALUE ary;
  ary = (VALUE) params;
  vt_y_sigma = rb_ary_entry(ary, 3);
  proc_f = rb_ary_entry(ary, 0);
  proc_df = rb_ary_entry(ary, 1);
  proc_fdf = rb_ary_entry(ary, 2);
  vx = Data_Wrap_Struct(cgsl_vector, 0, NULL, (gsl_vector *) x);
  vf = Data_Wrap_Struct(cgsl_vector, 0, NULL, f);
  vJ = Data_Wrap_Struct(cgsl_matrix, 0, NULL, J);
  switch (RARRAY(vt_y_sigma)->len) {
  case 2:
    vt = rb_ary_entry(vt_y_sigma, 0);
    vy = rb_ary_entry(vt_y_sigma, 1);
    if (NIL_P(proc_fdf)) {
      rb_funcall(proc_f, ID_call, 4, vx, vt, vy, vf);
      rb_funcall(proc_df, ID_call, 4, vx, vt, vy, vJ);
    } else 
      rb_funcall(proc_fdf, ID_call, 5, vx, vt, vy, vf, vJ);
    break;
  case 3:
    vt = rb_ary_entry(vt_y_sigma, 0);
    vy = rb_ary_entry(vt_y_sigma, 1);
    vsigma = rb_ary_entry(vt_y_sigma,2);
    if (NIL_P(proc_fdf)) {
      rb_funcall(proc_f, ID_call, 5, vx, vt, vy, vsigma, vf);
      rb_funcall(proc_df, ID_call, 5, vx, vt, vy, vsigma, vJ);
    } else 
      rb_funcall(proc_fdf, ID_call, 6, vx, vt, vy, vsigma, vf, vJ);
    break;
  default:
    rb_raise(rb_eArgError, "bad argument");
    break;    
  }
  return GSL_SUCCESS;
}

static VALUE rb_gsl_multifit_function_fdf_params(VALUE obj)
{
  gsl_multifit_function_fdf *f = NULL;
  Data_Get_Struct(obj, gsl_multifit_function_fdf, f);
  return (VALUE) f->params;
}

void Init_gsl_multifit()
{
  VALUE mgsl_multifit;
  VALUE cgsl_multifit_fdfsolver;
  VALUE cgsl_multifit_solver;

  mgsl_multifit = rb_define_module_under(mgsl, "MultiFit");

  cgsl_multifit_workspace = rb_define_class_under(mgsl_multifit, "Workspace", 
						  rb_cObject);
  rb_define_singleton_method(cgsl_multifit_workspace, "new", 
			     rb_gsl_multifit_workspace_new, 2);
  rb_define_singleton_method(cgsl_multifit_workspace, "alloc", 
			     rb_gsl_multifit_workspace_new, 2);
  rb_define_module_function(mgsl_multifit, "linear", rb_gsl_multifit_linear, -1);
  rb_define_module_function(mgsl_multifit, "wlinear", rb_gsl_multifit_wlinear, -1);

  cgsl_multifit_solver = rb_define_class_under(mgsl_multifit, "Solver", rb_cObject);
  cgsl_multifit_fdfsolver = rb_define_class_under(mgsl_multifit, "FdfSolver", 
						  cgsl_multifit_solver);
  cgsl_multifit_function_fdf = rb_define_class_under(mgsl_multifit, "Function_fdf",
						     rb_cObject);

  /*****/

  rb_define_singleton_method(cgsl_multifit_fdfsolver, "new", 
			     rb_gsl_multifit_fdfsolver_new, -1);
  rb_define_singleton_method(cgsl_multifit_fdfsolver, "alloc", 
			     rb_gsl_multifit_fdfsolver_new, -1);

  rb_define_singleton_method(cgsl_multifit_function_fdf, "new", 
			     rb_gsl_multifit_function_fdf_new, -1);
  rb_define_singleton_method(cgsl_multifit_function_fdf, "alloc", 
			     rb_gsl_multifit_function_fdf_new, -1);

  /*****/

  rb_define_method(cgsl_multifit_fdfsolver, "set", rb_gsl_multifit_fdfsolver_set, 2);
  rb_define_method(cgsl_multifit_fdfsolver, "name", rb_gsl_multifit_fdfsolver_name, 0);
  rb_define_method(cgsl_multifit_fdfsolver, "iterate", rb_gsl_multifit_fdfsolver_iterate, 0);
  rb_define_method(cgsl_multifit_fdfsolver, "position", rb_gsl_multifit_fdfsolver_position, 0);
  rb_define_alias(cgsl_multifit_fdfsolver, "x", "position");
  rb_define_method(cgsl_multifit_fdfsolver, "print_state", rb_gsl_multifit_fdfsolver_print_state, 1);
  rb_define_method(cgsl_multifit_fdfsolver, "fdf", rb_gsl_multifit_fdfsolver_fdf, 0);
  rb_define_method(cgsl_multifit_fdfsolver, "test_delta", rb_gsl_multifit_fdfsolver_test_delta, 2);
  rb_define_method(cgsl_multifit_fdfsolver, "test_gradient", rb_gsl_multifit_fdfsolver_test_gradient, -1);
  rb_define_method(cgsl_multifit_fdfsolver, "covar", rb_gsl_multifit_fdfsolver_covar, -1);
  rb_define_method(cgsl_multifit_fdfsolver, "gradienr", rb_gsl_multifit_fdfsolver_gradient, -1);
  rb_define_method(cgsl_multifit_fdfsolver, "x", rb_gsl_multifit_fdfsolver_x, 0);
  rb_define_method(cgsl_multifit_fdfsolver, "dx", rb_gsl_multifit_fdfsolver_dx, 0);
  rb_define_method(cgsl_multifit_fdfsolver, "f", rb_gsl_multifit_fdfsolver_f, 0);
  rb_define_method(cgsl_multifit_fdfsolver, "J", rb_gsl_multifit_fdfsolver_J, 0);
  rb_define_alias(cgsl_multifit_fdfsolver, "jac", "J");
  rb_define_alias(cgsl_multifit_fdfsolver, "jacobian", "J");
  rb_define_alias(cgsl_multifit_fdfsolver, "Jacobian", "J");

  rb_define_singleton_method(mgsl_multifit, "test_delta", rb_gsl_multifit_test_delta, 4);
  rb_define_singleton_method(mgsl_multifit, "test_gradient", rb_gsl_multifit_test_gradient, 2);
  rb_define_singleton_method(mgsl_multifit, "gradient", rb_gsl_multifit_gradient, -1);
  rb_define_singleton_method(mgsl_multifit, "covar", rb_gsl_multifit_covar, -1);

  rb_gsl_multifit_define_const(cgsl_multifit_fdfsolver);

  rb_define_method(cgsl_multifit_function_fdf, "set_procs", 
		   rb_gsl_multifit_function_fdf_set_procs, -1);
  rb_define_method(cgsl_multifit_function_fdf, "set_data", 
		   rb_gsl_multifit_function_fdf_set_data, -1);
  rb_define_method(cgsl_multifit_function_fdf, "params", 
		   rb_gsl_multifit_function_fdf_params, 0);
  rb_define_alias(cgsl_multifit_function_fdf, "param", "params");
}

#ifdef CHECK_WORKSPACE
#undef CHECK_WORKSPACE
#endif
#ifdef CHECK_FUNCTION_FDF
#undef CHECK_FUNCTION_FDF
#endif
