romanbsd-gsl 1.11.2.2

data/ext/nmf_wrap.c

@@ -0,0 +1,63 @@
+#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);
+
+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));
+}
+
+void Init_gsl_matrix_nmf(void) {
+/*
+  cgsl = rb_define_module("GSL");
+  cgsl_matrix = rb_define_module_under(cgsl, "Matrix");
+  cgsl_matrix = rb_const_get(rb_const_get(rb_cObject, rb_intern("GSL")),
+      rb_intern("Matrix"));
+*/
+
+  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);
+}

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);
+}