rb-gsl 1.15.3.1

data/ext/nmf.c

@@ -0,0 +1,171 @@
+/**
+ * NMF: Non-Negative Matrix Factorization
+ *
+ * Written by Roman Shterenzon
+ * (Slightly modified by Y.Tsunesada: just added "const" qualifiers etc.)
+ */
+
+#include <math.h>
+#include <time.h>
+#include <gsl/gsl_matrix.h>
+#include <gsl/gsl_blas.h> /* for multiplication */
+
+#define THRESH 0.000001
+#define MAXITER 1000
+
+#undef DEBUG
+
+#define mm(a, b) gsl_matrix_mult(a, b)
+//gsl_matrix * gsl_matrix_mult(gsl_matrix *a, gsl_matrix *b)
+gsl_matrix * gsl_matrix_mult(const gsl_matrix *a, const gsl_matrix *b)
+{
+  gsl_matrix *c;
+  c = gsl_matrix_alloc(a->size1, b->size2);
+
+  gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, a, b, 0.0, c);
+  return c;
+}
+
+// pretty print
+//void pp(gsl_matrix *m)
+void pp(const gsl_matrix *m)
+{
+  int r, c;
+
+  for(r=0; r<m->size1; r++) {
+    for(c=0; c<m->size2; c++) {
+      printf(" %.2f", gsl_matrix_get(m, r, c));
+    }
+    printf("\n");
+  }
+}
+
+/* Returns a distance cost */
+//double difcost(gsl_matrix *a, gsl_matrix *b)
+double difcost(const gsl_matrix *a, const gsl_matrix *b)
+{
+  int i, j;
+  double dif=0, d;
+
+  for (i=0; i < a->size1; i++)
+  {
+    for (j=0; j < a->size2; j++)
+    {
+      d = gsl_matrix_get(a, i, j) - gsl_matrix_get(b, i, j);
+      dif += d*d;
+	//      dif += pow(gsl_matrix_get(a, i, j) - gsl_matrix_get(b, i, j), 2);
+    }
+  }
+  return dif;
+}
+
+static void initmatrix(gsl_matrix *m, double min, double max)
+{
+  int i,j;
+  double val;
+
+  srand(time(NULL));
+
+  for(i=0; i < m->size1; i++)
+  {
+    for(j=0; j < m->size2; j++)
+    {
+      val = min + (int) (max * (rand() / (RAND_MAX + min)));
+      gsl_matrix_set(m, i, j, val);
+    }
+  }
+}
+
+static double update(gsl_matrix *v, gsl_matrix *w, gsl_matrix *h)
+{
+  double dist = 0;
+  gsl_matrix *wt=NULL, *ht=NULL, *wh=NULL;
+  gsl_matrix *w_h=NULL, *wt_w=NULL;
+  gsl_matrix *wt_v = NULL;
+  gsl_matrix *v_ht=NULL, *wt_w_h=NULL, *w_h_ht=NULL;
+
+  wt = gsl_matrix_alloc(w->size2, w->size1);
+  gsl_matrix_transpose_memcpy(wt, w);
+  ht = gsl_matrix_alloc(h->size2, h->size1);
+  gsl_matrix_transpose_memcpy(ht, h);
+
+  // wt * v
+  wt_v = mm(wt, v);
+
+  // wt * w * h
+  wt_w = mm(wt, w);
+  wt_w_h = mm(wt_w, h);
+  gsl_matrix_free(wt_w);
+
+  // h = h.mul_elements(wt * v).div_elements(wt * w * h)
+  gsl_matrix_mul_elements(h, wt_v);
+  gsl_matrix_div_elements(h, wt_w_h);
+  gsl_matrix_free(wt_v);
+  gsl_matrix_free(wt_w_h);
+
+  // v * ht
+  v_ht = mm(v, ht);
+
+  // w * h * ht
+  w_h = mm(w, h);
+  w_h_ht = mm(w_h, ht);
+  gsl_matrix_free(w_h);
+
+  // w = w.mul_elements(v * ht).div_elements(w * h * ht)
+  gsl_matrix_mul_elements(w, v_ht);
+  gsl_matrix_div_elements(w, w_h_ht);
+  gsl_matrix_free(v_ht);
+  gsl_matrix_free(w_h_ht);
+
+  gsl_matrix_free(wt);
+  gsl_matrix_free(ht);
+
+  wh = mm(w, h);
+  dist = difcost(v, wh);
+  gsl_matrix_free(wh);
+
+  // w and h were modified in place
+  return dist;
+}
+
+/* The main thing - compute the nmf */
+int gsl_matrix_nmf(gsl_matrix *v, int cols, gsl_matrix **w, gsl_matrix **h)
+{
+  double dist = 1;
+  int iter = 1;
+  double min, max;
+
+#ifdef DEBUG
+  printf("\nCols: %d\nv:\n", cols);
+  pp(v);
+#endif
+
+  gsl_matrix_minmax(v, &min, &max);
+
+#ifdef DEBUG
+  printf("Min: %f, Max: %f\n", min, max);
+#endif
+  *w = gsl_matrix_alloc(v->size1, cols);
+  initmatrix(*w, min, max/2); // the multiplicative rules tend to increase w
+
+  *h = gsl_matrix_alloc(cols, v->size2);
+  initmatrix(*h, min, max);
+
+  while(dist >= THRESH && iter < MAXITER)
+  {
+    dist = update(v, *w, *h);
+#ifdef DEBUG
+    printf("Iteration: %d, distance: %f\n", iter, dist);
+    printf("\nw:\n");
+    pp(*w);
+    printf("\nh:\n");
+    pp(*h);
+    printf("\n");
+#endif
+    iter++;
+  }
+#ifdef DEBUG
+  printf("Ended\n");
+#endif
+  return GSL_SUCCESS;
+}

data/ext/nmf_wrap.c

@@ -0,0 +1,75 @@
+/**
+ * NMF: Non-Negative Matrix Factorization - Ruby wrapper
+ *
+ * Written by Roman Shterenzon
+ *
+ */
+
+#include <ruby.h>
+#include <gsl/gsl_matrix.h>
+
+int gsl_matrix_nmf(gsl_matrix *v, int cols, gsl_matrix **w, gsl_matrix **h);
+//double difcost(gsl_matrix *a, gsl_matrix *b);
+double difcost(const gsl_matrix *a, const gsl_matrix *b);
+
+//VALUE mNMF;
+static VALUE mNMF;
+extern VALUE cgsl_matrix;
+
+/*
+ * call-seq:
+ *   nmf(GSL::Matrix, columns) -> [GSL::Matrix, GSL::Matrix]
+ *
+ * Calculates the NMF of the given +matrix+, returns the W and H matrices
+ */
+static VALUE nmf_wrap(VALUE obj, VALUE matrix, VALUE cols)
+{
+  gsl_matrix *w, *h, *m;
+  unsigned int c;
+  VALUE arr;
+
+  if ( ! FIXNUM_P(cols) || (c=NUM2INT(cols)) <= 0 ) {
+    rb_raise(rb_eArgError, "Number of columns should be a positive integer.");
+  }
+  arr = rb_ary_new2(2);
+  Data_Get_Struct(matrix, gsl_matrix, m);
+
+  /* compute the NMF */
+  gsl_matrix_nmf(m, c, &w, &h);
+
+  rb_ary_push(arr, Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, w));
+  rb_ary_push(arr, Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, h));
+
+  return arr;
+}
+
+/*
+ * call-seq:
+ *   difcost(GSL::Matrix, GSL::Matrix) -> Float
+ *
+ * Calculates the geometric distance between two matrices
+ */
+static VALUE difcost_wrap(VALUE obj, VALUE matrix1, VALUE matrix2)
+{
+  gsl_matrix *m1, *m2;
+  Data_Get_Struct(matrix1, gsl_matrix, m1);
+  Data_Get_Struct(matrix2, gsl_matrix, m2);
+  return rb_float_new(difcost(m1, m2));
+}
+
+/* call-seq:
+ *   nmf(cols) -> [GSL::Matrix, GSL::Matrix]
+ */
+static VALUE matrix_nmf(VALUE obj, VALUE cols)
+{
+  //  nmf_wrap(cgsl_matrix, obj, cols);
+  return nmf_wrap(cgsl_matrix, obj, cols);
+}
+
+void Init_gsl_matrix_nmf(void) {
+  mNMF = rb_define_module_under(cgsl_matrix, "NMF");
+
+  rb_define_singleton_method(mNMF, "nmf", nmf_wrap, 2);
+  rb_define_singleton_method(mNMF, "difcost", difcost_wrap, 2);
+  rb_define_method(cgsl_matrix, "nmf", matrix_nmf, 1);
+}

data/ext/ntuple.c

@@ -0,0 +1,469 @@
+/*
+  ntuple.c
+  Ruby/GSL: Ruby extension library for GSL (GNU Scientific Library)
+    (C) Copyright 2001-2006 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_function.h"
+#include "rb_gsl_histogram.h"
+#include <gsl/gsl_ntuple.h>
+
+static VALUE cgsl_ntuple;
+static VALUE cgsl_ntuple_select_fn;
+static VALUE cgsl_ntuple_value_fn;
+
+static VALUE rb_gsl_ntuple_new(int argc, VALUE *argv, VALUE klass)
+{
+  gsl_vector *v = NULL;
+  gsl_matrix *m = NULL;
+  gsl_ntuple *n = NULL;
+  double *data = NULL;
+  size_t size;
+  switch (argc) {
+  case 2:
+  case 3:
+    if (VECTOR_P(argv[1])) {
+      Data_Get_Struct(argv[1], gsl_vector, v);
+      data = v->data;
+      size = v->size;
+    } else if (MATRIX_P(argv[1])) {
+      Data_Get_Struct(argv[1], gsl_matrix, m);
+      data = m->data;
+      size = m->size1*m->size2;
+    } else {
+      rb_raise(rb_eTypeError, "Vector or Matrix expected");
+    }
+    if (argc == 3) size = FIX2INT(argv[2]);
+    break;
+  default:
+    rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 3)", argc);
+    break;
+  }
+  n = gsl_ntuple_create(STR2CSTR(argv[0]), data, size*sizeof(double));
+  return Data_Wrap_Struct(klass, 0, gsl_ntuple_close, n);
+}
+
+VALUE rb_gsl_ntuple_open(int argc, VALUE *argv, VALUE klass)
+{
+  gsl_vector *v = NULL;
+  gsl_matrix *m = NULL;
+  gsl_ntuple *n = NULL;
+  double *data = NULL;
+  size_t size;
+  switch (argc) {
+  case 2:
+  case 3:
+    if (VECTOR_P(argv[1])) {
+      Data_Get_Struct(argv[1], gsl_vector, v);
+      data = v->data;
+      size = v->size;
+    } else if (MATRIX_P(argv[1])) {
+      Data_Get_Struct(argv[1], gsl_matrix, m);
+      data = m->data;
+      size = m->size1*m->size2;
+    } else {
+      rb_raise(rb_eTypeError, "Vector or Matrix expected");
+    }
+    if (argc == 3) size = FIX2INT(argv[2]);
+    break;
+  default:
+    rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 3)", argc);
+    break;
+  }
+  n = gsl_ntuple_open(STR2CSTR(argv[0]), data, size*sizeof(double));
+  return Data_Wrap_Struct(klass, 0, gsl_ntuple_close, n);
+}
+
+VALUE rb_gsl_ntuple_write(VALUE obj)
+{
+  gsl_ntuple *n = NULL;
+  Data_Get_Struct(obj, gsl_ntuple, n);
+  gsl_ntuple_write(n);
+  return obj;
+}
+
+VALUE rb_gsl_ntuple_bookdata(VALUE obj)
+{
+  gsl_ntuple *n = NULL;
+  Data_Get_Struct(obj, gsl_ntuple, n);
+  gsl_ntuple_bookdata(n);
+  return obj;
+}
+
+VALUE rb_gsl_ntuple_read(VALUE obj)
+{
+  gsl_ntuple *n = NULL;
+  Data_Get_Struct(obj, gsl_ntuple, n);
+  gsl_ntuple_read(n);
+  return obj;
+}
+
+VALUE rb_gsl_ntuple_close(VALUE klass, VALUE obj)
+{
+  gsl_ntuple *n = NULL;
+  Data_Get_Struct(obj, gsl_ntuple, n);
+  gsl_ntuple_close(n);
+  return Qnil;
+}
+
+VALUE rb_gsl_ntuple_size(VALUE klass, VALUE obj)
+{
+  gsl_ntuple *n = NULL;
+  Data_Get_Struct(obj, gsl_ntuple, n);
+  return INT2FIX(n->size);
+}
+
+VALUE rb_gsl_ntuple_data(VALUE obj)
+{
+  gsl_ntuple *n = NULL;
+  gsl_vector_view *v = NULL;
+  Data_Get_Struct(obj, gsl_ntuple, n);
+  v = gsl_vector_view_alloc();
+  v->vector.size = n->size;
+  v->vector.data = n->ntuple_data;
+  return Data_Wrap_Struct(cgsl_vector_view, 0, gsl_vector_view_free, v);
+}
+
+/***** select_fn *****/
+
+static gsl_ntuple_select_fn* gsl_ntuple_select_fn_alloc();
+static void gsl_ntuple_select_fn_free(gsl_ntuple_select_fn *ptr);
+int rb_gsl_ntuple_select_fn_f(void *data, void *p);
+static void gsl_ntuple_select_fn_mark(gsl_ntuple_select_fn *ptr);
+
+static gsl_ntuple_select_fn* gsl_ntuple_select_fn_alloc()
+{
+  gsl_ntuple_select_fn *ptr = NULL;
+  ptr = ALLOC(gsl_ntuple_select_fn);
+  if (ptr == NULL) rb_raise(rb_eRuntimeError, "malloc failed");
+  ptr->function = &rb_gsl_ntuple_select_fn_f;
+  /*  (VALUE) ptr->params = rb_ary_new2(3);*/
+  ptr->params = (void *) rb_ary_new2(3);
+  rb_ary_store((VALUE) ptr->params, 1, Qnil);
+  return ptr;
+}
+
+static void gsl_ntuple_select_fn_free(gsl_ntuple_select_fn *ptr)
+{
+  free((gsl_ntuple_select_fn *) ptr);
+}
+
+static void gsl_ntuple_select_fn_mark(gsl_ntuple_select_fn *ptr)
+{
+  rb_gc_mark((VALUE) ptr->params);
+}
+
+static VALUE rb_gsl_ntuple_select_fn_set_f(int argc, VALUE *argv, VALUE obj)
+{
+  gsl_ntuple_select_fn *F = NULL;
+  VALUE ary, ary2;
+  size_t i;
+  Data_Get_Struct(obj, gsl_ntuple_select_fn, F);
+  if (F->params == NULL) {
+    ary = rb_ary_new2(3);
+    /*    (VALUE) F->params = ary;*/
+    F->params = (void *) ary;
+  } else {
+    ary = (VALUE) F->params;
+  }
+  rb_ary_store(ary, 1, Qnil);
+
+  switch (argc) {
+  case 0:
+    break;
+  case 1:
+    CHECK_PROC(argv[0]);
+    rb_ary_store(ary, 0, argv[0]);
+    break;
+  case 2:
+    CHECK_PROC(argv[0]);
+    rb_ary_store(ary, 0, argv[0]);
+    rb_ary_store(ary, 1, argv[1]);
+    break;
+  default:
+    CHECK_PROC(argv[0]);
+    rb_ary_store(ary, 0, argv[0]);
+    ary2 = rb_ary_new2(argc-1);
+    for (i = 1; i < argc; i++) rb_ary_store(ary2, i-1, argv[i]);
+    rb_ary_store(ary, 1, ary2);
+    break;
+  }
+  if (rb_block_given_p()) rb_ary_store(ary, 0, RB_GSL_MAKE_PROC);
+  return obj;
+}
+
+int rb_gsl_ntuple_select_fn_f(void *data, void *p)
+{
+  VALUE result, ary, proc, params, vv;
+  gsl_vector_view vtmp;
+  size_t size;
+  ary = (VALUE) p;
+  proc = rb_ary_entry(ary, 0);
+  params = rb_ary_entry(ary, 1);
+  size = FIX2INT(rb_ary_entry(ary, 2));
+  vtmp.vector.data = (double *) data;
+  vtmp.vector.size = size;
+  vtmp.vector.stride = 1;
+  vv = Data_Wrap_Struct(cgsl_vector_view, 0, NULL, &vtmp);
+  if (NIL_P(params)) result = rb_funcall(proc, RBGSL_ID_call, 1, vv);
+  else result = rb_funcall(proc, RBGSL_ID_call, 2, vv, params);
+  return FIX2INT(result);
+}
+
+static VALUE rb_gsl_ntuple_select_fn_params(VALUE obj)
+{
+  gsl_ntuple_select_fn *F = NULL;
+  Data_Get_Struct(obj, gsl_ntuple_select_fn, F);
+  return rb_ary_entry((VALUE) F->params, 1);
+}
+
+static VALUE rb_gsl_ntuple_select_fn_set_params(int argc, VALUE *argv, VALUE obj)
+{
+  gsl_ntuple_select_fn *F = NULL;
+  VALUE ary, ary2;
+  size_t i;
+  if (argc == 0) return obj;
+  Data_Get_Struct(obj, gsl_ntuple_select_fn, F);
+  ary = (VALUE) F->params;
+  if (argc == 1) {
+    rb_ary_store(ary, 1, argv[0]);
+  } else {
+    ary2 = rb_ary_new2(argc);
+    for (i = 0; i < argc; i++) rb_ary_store(ary2, i, argv[i]);
+    rb_ary_store(ary, 1, ary2);
+  }
+  return obj;
+}
+
+static VALUE rb_gsl_ntuple_select_fn_new(int argc, VALUE *argv, VALUE klass)
+{
+  gsl_ntuple_select_fn *F = NULL;
+  VALUE ff;
+  F = gsl_ntuple_select_fn_alloc();
+  ff = Data_Wrap_Struct(klass, gsl_ntuple_select_fn_mark, gsl_ntuple_select_fn_free, F);
+  rb_gsl_ntuple_select_fn_set_f(argc, argv, ff);
+  return ff;
+}
+
+/***** value_fn *****/
+static gsl_ntuple_value_fn* gsl_ntuple_value_fn_alloc();
+static void gsl_ntuple_value_fn_free(gsl_ntuple_value_fn *ptr);
+static double rb_gsl_ntuple_value_fn_f(void *data, void *p);
+static void gsl_ntuple_value_fn_mark(gsl_ntuple_value_fn *ptr);
+
+static gsl_ntuple_value_fn* gsl_ntuple_value_fn_alloc()
+{
+  gsl_ntuple_value_fn *ptr = NULL;
+  ptr = ALLOC(gsl_ntuple_value_fn);
+  if (ptr == NULL) rb_raise(rb_eRuntimeError, "malloc failed");
+  ptr->function = &rb_gsl_ntuple_value_fn_f;
+  /*  (VALUE) ptr->params = rb_ary_new2(3);*/
+  ptr->params = (void *) rb_ary_new2(3);
+  rb_ary_store((VALUE) ptr->params, 1, Qnil);
+  return ptr;
+}
+
+static void gsl_ntuple_value_fn_mark(gsl_ntuple_value_fn *ptr)
+{
+  rb_gc_mark((VALUE) ptr->params);
+}
+
+static void gsl_ntuple_value_fn_free(gsl_ntuple_value_fn *ptr)
+{
+  free((gsl_ntuple_value_fn *) ptr);
+}
+
+static VALUE rb_gsl_ntuple_value_fn_set_f(int argc, VALUE *argv, VALUE obj)
+{
+  gsl_ntuple_value_fn *F = NULL;
+  VALUE ary, ary2;
+  size_t i;
+  Data_Get_Struct(obj, gsl_ntuple_value_fn, F);
+  if (F->params == NULL) {
+    ary = rb_ary_new2(3);
+    /*    (VALUE) F->params = ary;*/
+    F->params = (void *) ary;
+  } else {
+    ary = (VALUE) F->params;
+  }
+  rb_ary_store(ary, 1, Qnil);
+  switch (argc) {
+  case 0:
+    break;
+  case 1:
+    CHECK_PROC(argv[0]);
+    rb_ary_store(ary, 0, argv[0]);
+    break;
+  case 2:
+    CHECK_PROC(argv[0]);
+    rb_ary_store(ary, 0, argv[0]);
+    rb_ary_store(ary, 1, argv[1]);
+    break;
+  default:
+    CHECK_PROC(argv[0]);
+    rb_ary_store(ary, 0, argv[0]);
+    ary2 = rb_ary_new2(argc-1);
+    for (i = 1; i < argc; i++) rb_ary_store(ary2, i-1, argv[i]);
+    rb_ary_store(ary, 1, ary2);
+    break;
+  }
+  if (rb_block_given_p()) rb_ary_store(ary, 0, RB_GSL_MAKE_PROC);
+  return obj;
+}
+
+static double rb_gsl_ntuple_value_fn_f(void *data, void *p)
+{
+  VALUE result, ary, proc, params, vv;
+  gsl_vector_view vtmp;
+  ary = (VALUE) p;
+  proc = rb_ary_entry(ary, 0);
+  params = rb_ary_entry(ary, 1);
+  vtmp.vector.data = (double *) data;
+  vtmp.vector.size = FIX2INT(rb_ary_entry(ary, 2));
+  vtmp.vector.stride = 1;
+  vv = Data_Wrap_Struct(cgsl_vector_view, 0, NULL, &vtmp);
+  if (NIL_P(params)) result = rb_funcall(proc, RBGSL_ID_call, 1, vv);
+  else result = rb_funcall(proc, RBGSL_ID_call, 2, vv, params);
+  return NUM2DBL(result);
+}
+
+static VALUE rb_gsl_ntuple_value_fn_params(VALUE obj)
+{
+  gsl_ntuple_value_fn *F = NULL;
+  Data_Get_Struct(obj, gsl_ntuple_value_fn, F);
+  return rb_ary_entry((VALUE) F->params, 1);
+}
+
+static VALUE rb_gsl_ntuple_value_fn_set_params(int argc, VALUE *argv, VALUE obj)
+{
+  gsl_ntuple_value_fn *F = NULL;
+  VALUE ary, ary2;
+  size_t i;
+  if (argc == 0) return obj;
+  Data_Get_Struct(obj, gsl_ntuple_value_fn, F);
+  ary = (VALUE) F->params;
+  if (argc == 1) {
+    rb_ary_store(ary, 1, argv[0]);
+  } else {
+    ary2 = rb_ary_new2(argc);
+    for (i = 0; i < argc; i++) rb_ary_store(ary2, i, argv[i]);
+    rb_ary_store(ary, 1, ary2);
+  }
+  return obj;
+}
+
+
+static VALUE rb_gsl_ntuple_value_fn_new(int argc, VALUE *argv, VALUE klass)
+{
+  gsl_ntuple_value_fn *F = NULL;
+  VALUE ff;
+  F = gsl_ntuple_value_fn_alloc();
+  ff = Data_Wrap_Struct(klass, gsl_ntuple_value_fn_mark, gsl_ntuple_value_fn_free, F);
+  rb_gsl_ntuple_value_fn_set_f(argc, argv, ff);
+  return ff;
+}
+
+/* singleton method */
+static VALUE rb_gsl_ntuple_project(VALUE obj, VALUE hh, VALUE nn,
+				   VALUE vvfn, VALUE vsfn)
+{
+  gsl_histogram *h = NULL;
+  gsl_ntuple *n = NULL;
+  gsl_ntuple_value_fn *vfn = NULL;
+  gsl_ntuple_select_fn *sfn = NULL;
+  int status;
+  size_t size;
+  if (!rb_obj_is_kind_of(hh, cgsl_histogram))
+    rb_raise(rb_eTypeError, "argument 1: Histogram expected");
+  Data_Get_Struct(hh, gsl_histogram, h);
+  if (!rb_obj_is_kind_of(nn, cgsl_ntuple))
+    rb_raise(rb_eTypeError, "argument 2: Ntuple expected");
+  Data_Get_Struct(nn, gsl_ntuple, n);
+  if (!rb_obj_is_kind_of(vvfn, cgsl_ntuple_value_fn)) 
+    rb_raise(rb_eTypeError, "argument 3: Ntuple::ValueFn expected");
+  Data_Get_Struct(vvfn, gsl_ntuple_value_fn, vfn);
+  if (!rb_obj_is_kind_of(vsfn, cgsl_ntuple_select_fn)) 
+    rb_raise(rb_eTypeError, "argument 4: Ntuple::SelectFn expected");
+  Data_Get_Struct(vsfn, gsl_ntuple_select_fn, sfn);
+
+  size = n->size/sizeof(double);
+  rb_ary_store((VALUE) vfn->params, 2, INT2FIX(size));
+  rb_ary_store((VALUE) sfn->params, 2, INT2FIX(size));
+  status = gsl_ntuple_project(h, n, vfn, sfn);
+  return INT2FIX(status);
+}
+
+/* method */
+static VALUE rb_gsl_ntuple_project2(VALUE obj, VALUE hh, VALUE vvfn, VALUE vsfn)
+{
+  gsl_histogram *h = NULL;
+  gsl_ntuple *n = NULL;
+  gsl_ntuple_value_fn *vfn = NULL;
+  gsl_ntuple_select_fn *sfn = NULL;
+  int status;
+  size_t size;
+  CHECK_HISTOGRAM(hh);
+  Data_Get_Struct(obj, gsl_ntuple, n);
+  Data_Get_Struct(hh, gsl_histogram, h);
+  if (!rb_obj_is_kind_of(vvfn, cgsl_ntuple_value_fn)) 
+    rb_raise(rb_eTypeError, "argument 2: Ntuple::ValueFn expected");
+  Data_Get_Struct(vvfn, gsl_ntuple_value_fn, vfn);
+  if (!rb_obj_is_kind_of(vsfn, cgsl_ntuple_select_fn)) 
+    rb_raise(rb_eTypeError, "argument 3: Ntuple::SelectFn expected");
+  Data_Get_Struct(vsfn, gsl_ntuple_select_fn, sfn);
+  size = n->size/sizeof(double);
+  rb_ary_store((VALUE) vfn->params, 2, INT2FIX(size));
+  rb_ary_store((VALUE) sfn->params, 2, INT2FIX(size));
+  status = gsl_ntuple_project(h, n, vfn, sfn);
+  return INT2FIX(status);
+}
+
+void Init_gsl_ntuple(VALUE module)
+{
+  cgsl_ntuple = rb_define_class_under(module, "Ntuple", cGSL_Object);
+  cgsl_ntuple_select_fn = rb_define_class_under(cgsl_ntuple, "SelectFn", cGSL_Object);
+  cgsl_ntuple_value_fn = rb_define_class_under(cgsl_ntuple, "ValueFn", cGSL_Object);
+
+  rb_define_singleton_method(cgsl_ntuple, "create", rb_gsl_ntuple_new, -1);
+  rb_define_singleton_method(cgsl_ntuple, "alloc", rb_gsl_ntuple_new, -1);
+  rb_define_singleton_method(cgsl_ntuple, "open", rb_gsl_ntuple_open, -1);
+  rb_define_singleton_method(cgsl_ntuple, "close", rb_gsl_ntuple_close, 0);
+
+  rb_define_method(cgsl_ntuple, "size", rb_gsl_ntuple_size, 0);
+  rb_define_method(cgsl_ntuple, "write", rb_gsl_ntuple_write, 0);
+  rb_define_method(cgsl_ntuple, "bookdata", rb_gsl_ntuple_bookdata, 0);
+
+  rb_define_method(cgsl_ntuple, "read", rb_gsl_ntuple_read, 0);
+
+  rb_define_method(cgsl_ntuple, "data", rb_gsl_ntuple_data, 0);
+  rb_define_alias(cgsl_ntuple, "get_data", "data");
+  rb_define_alias(cgsl_ntuple, "ntuple_data", "data");
+
+  rb_define_singleton_method(cgsl_ntuple_select_fn, "alloc",
+			     rb_gsl_ntuple_select_fn_new, -1);
+  rb_define_method(cgsl_ntuple_select_fn, "set",
+		   rb_gsl_ntuple_select_fn_set_f, -1);
+  rb_define_method(cgsl_ntuple_select_fn, "set_params",
+		   rb_gsl_ntuple_select_fn_set_params, -1);
+  rb_define_method(cgsl_ntuple_select_fn, "params",
+		   rb_gsl_ntuple_select_fn_params, 0);
+
+  rb_define_singleton_method(cgsl_ntuple_value_fn, "alloc",
+			     rb_gsl_ntuple_value_fn_new, -1);
+  rb_define_method(cgsl_ntuple_value_fn, "set",
+		   rb_gsl_ntuple_value_fn_set_f, -1);
+  rb_define_method(cgsl_ntuple_value_fn, "set_params",
+		   rb_gsl_ntuple_value_fn_set_params, -1);
+  rb_define_method(cgsl_ntuple_value_fn, "params",
+		   rb_gsl_ntuple_value_fn_params, 0);
+
+  rb_define_singleton_method(cgsl_ntuple, "project", rb_gsl_ntuple_project, 4);
+  rb_define_method(cgsl_ntuple, "project", rb_gsl_ntuple_project2, 3);
+}