linalg 1.0.2

data/ext/linalg/dcomplex.c

@@ -0,0 +1,359 @@
+/*
+ * Copyright (c) 2004-2008 by James M. Lawrence
+ *
+ * See LICENSE
+ *
+ */
+
+#include "dcomplex.h"
+
+/*******************************************************
+ *
+ * globals
+ *
+ *******************************************************/
+
+VALUE rb_cDComplex ;
+
+/*******************************************************
+ *
+ * utils
+ *
+ *******************************************************/
+
+#define get_doublecomplex(ptr, obj) Data_Get_Struct(obj, doublecomplex, ptr)
+#define wrap_doublecomplex(obj) Data_Wrap_Struct(rb_cDComplex, 0, rb_dcomplex_free, obj)
+
+/*******************************************************
+ *
+ * alloc/free
+ *
+ *******************************************************/
+
+void rb_dcomplex_free(doublecomplex* c)
+{
+    free(c) ;
+}
+
+VALUE rb_dcomplex_allocate(VALUE klass)
+{
+    doublecomplex* c ;
+    VALUE rc = Data_Make_Struct(klass,
+                                doublecomplex,
+                                0,
+                                rb_dcomplex_free,
+                                c) ;
+    return rc ;
+}
+
+/*******************************************************
+ *
+ * conversions
+ *
+ *******************************************************/
+
+VALUE rb_dcomplex_new(doublecomplex a)
+{
+    doublecomplex* c = ALLOC(doublecomplex) ;
+    *c = a ;
+    return wrap_doublecomplex(c) ;
+}
+
+doublecomplex rb_num2doublecomplex(VALUE ra)
+{
+    if( rb_obj_is_kind_of(ra, rb_cDComplex) )
+    {
+        doublecomplex* a ;
+        get_doublecomplex(a, ra) ;
+        return *a ;
+    }
+    else
+    {
+        doublecomplex c ;
+        c.r = (doublereal)NUM2DBL(ra) ;
+        c.i = (doublereal)0.0 ;
+        return c ;
+    }
+}
+
+/*******************************************************
+ *
+ * instance methods
+ *
+ *******************************************************/
+
+/*
+ *
+ */
+VALUE rb_dcomplex_initialize(int argc, VALUE* argv, VALUE self)
+{
+    VALUE rre ;
+    VALUE rim ;
+    doublecomplex* a ;
+    int n = rb_scan_args(argc, argv, "02", &rre, &rim) ;
+    get_doublecomplex(a, self) ;
+
+    if( n == 2 )
+    {
+        a->r = (doublereal)NUM2DBL(rre) ;
+        a->i = (doublereal)NUM2DBL(rim) ;
+    }
+    else if( n == 1 )
+    {
+        a->r = (doublereal)NUM2DBL(rre) ;
+        a->i = (doublereal)0.0 ;
+    }
+    else
+    {
+        a->r = (doublereal)0.0 ;
+        a->i = (doublereal)0.0 ;
+    }
+    
+    return self ;
+}
+
+VALUE rb_dcomplex_real(VALUE self)
+{
+    doublecomplex* a ;
+    get_doublecomplex(a, self) ;
+    return rb_float_new((double)a->r) ;
+}
+
+VALUE rb_dcomplex_imag(VALUE self)
+{
+    doublecomplex* a ;
+    get_doublecomplex(a, self) ;
+    return rb_float_new((double)a->i) ;
+}
+
+VALUE rb_dcomplex_add(VALUE self, VALUE rb)
+{
+    doublecomplex* a ;
+    doublecomplex* c ;
+    VALUE rc ;
+    
+    get_doublecomplex(a, self) ;
+    c = ALLOC(doublecomplex) ;
+    rc = wrap_doublecomplex(c) ;
+
+    if( rb_obj_is_kind_of(rb, rb_cDComplex) )
+    {
+        doublecomplex* b ;
+        get_doublecomplex(b, rb) ;
+        c->r = a->r + b->r ;
+        c->i = a->i + b->i ;
+    }
+    else
+    {
+        doublereal b = (doublereal)NUM2DBL(rb) ;
+        c->r = a->r + b ;
+        c->i = a->i ;
+    }
+    
+    return rc ;
+}
+
+VALUE rb_dcomplex_sub(VALUE self, VALUE rb)
+{
+    doublecomplex* a ;
+    doublecomplex* c ;
+    VALUE rc ;
+    
+    get_doublecomplex(a, self) ;
+    c = ALLOC(doublecomplex) ;
+    rc = wrap_doublecomplex(c) ;
+
+    if( rb_obj_is_kind_of(rb, rb_cDComplex) )
+    {
+        doublecomplex* b ;
+        get_doublecomplex(b, rb) ;
+        c->r = a->r - b->r ;
+        c->i = a->i - b->i ;
+    }
+    else
+    {
+        doublereal b = (doublereal)NUM2DBL(rb) ;
+        c->r = a->r - b ;
+        c->i = a->i ;
+    }
+    
+    return rc ;
+}
+
+VALUE rb_dcomplex_mul(VALUE self, VALUE rb)
+{
+    doublecomplex* a ;
+    doublecomplex* c ;
+    VALUE rc ;
+    
+    get_doublecomplex(a, self) ;
+    c = ALLOC(doublecomplex) ;
+    rc = wrap_doublecomplex(c) ;
+
+    if( rb_obj_is_kind_of(rb, rb_cDComplex) )
+    {
+        doublecomplex* b ;
+        get_doublecomplex(b, rb) ;
+        c->r = a->r*b->r - a->i*b->i ;
+        c->i = a->r*b->i + a->i*b->r ;
+    }
+    else
+    {
+        doublereal b = (doublereal)NUM2DBL(rb) ;
+        c->r = a->r*b ;
+        c->i = a->i*b ;
+    }
+    
+    return rc ;
+}
+
+VALUE rb_dcomplex_div(VALUE self, VALUE rb)
+{
+    doublecomplex* a ;
+    doublecomplex* c ;
+    VALUE rc ;
+    
+    get_doublecomplex(a, self) ;
+    c = ALLOC(doublecomplex) ;
+    rc = wrap_doublecomplex(c) ;
+
+    if( rb_obj_is_kind_of(rb, rb_cDComplex) )
+    {
+        doublecomplex* b ;
+        doublereal bottom ;
+        get_doublecomplex(b, rb) ;
+
+        bottom = b->r*b->r + b->i*b->i ;
+        
+        c->r = a->r*b->r + a->i*b->i ;
+        c->i = a->i*b->r - a->r*b->i ;
+
+        c->r /= bottom ;
+        c->i /= bottom ;
+    }
+    else
+    {
+        doublereal b = (doublereal)NUM2DBL(rb) ;
+        c->r = a->r/b ;
+        c->i = a->i/b ;
+    }
+    
+    return rc ;
+}
+
+VALUE rb_dcomplex_within(VALUE self, VALUE repsilon, VALUE rb)
+{
+    doublecomplex* a ;
+    doublereal epsilon ;
+
+    get_doublecomplex(a, self) ;
+    epsilon = (doublereal)NUM2DBL(repsilon) ;
+    
+    if( rb_obj_is_kind_of(rb, rb_cDComplex) )
+    {
+        doublecomplex* b ;
+        get_doublecomplex(b, rb) ;
+        if( fabs(a->r - b->r) > epsilon ||
+            fabs(a->i - b->i) > epsilon )
+        {
+            return Qfalse ;
+        }
+    }
+    else
+    {
+        doublereal b = (doublereal)NUM2DBL(rb) ;
+        if( fabs(a->r - b) > epsilon ||
+            fabs(a->i - (doublereal)0.0) > epsilon )
+        {
+            return Qfalse ;
+        }
+    }
+
+    return Qtrue ;
+}
+
+VALUE rb_dcomplex_conj(VALUE self)
+{
+    doublecomplex* a ;
+    doublecomplex* c ;
+
+    get_doublecomplex(a, self) ;
+    c = ALLOC(doublecomplex) ;
+
+    c->r = a->r ;
+    c->i = -a->i ;
+    
+    return wrap_doublecomplex(c) ;
+}
+
+VALUE rb_dcomplex_abs(VALUE self)
+{
+    doublecomplex* c ;
+    get_doublecomplex(c, self) ;
+    return rb_float_new((double)(sqrt(c->r*c->r + c->i*c->i))) ;
+}
+
+VALUE rb_dcomplex_abs2(VALUE self)
+{
+    doublecomplex* c ;
+    get_doublecomplex(c, self) ;
+    return rb_float_new((double)(c->r*c->r + c->i*c->i)) ;
+}
+
+VALUE rb_dcomplex_coerce(VALUE self, VALUE other)
+{
+    return rb_assoc_new(self, other) ;
+}
+
+VALUE rb_dcomplex_to_doublecomplex_ptr(VALUE self)
+{
+    doublecomplex* c ;
+    get_doublecomplex(c, self) ;
+    return ULONG2NUM((unsigned long)c) ;
+}
+
+VALUE rb_dcomplex_doubleequals(VALUE self, VALUE rb)
+{
+    doublecomplex* a ;
+    get_doublecomplex(a, self) ;
+
+    if( rb_obj_is_kind_of(rb, rb_cDComplex) )
+    {
+        doublecomplex* b ;
+        get_doublecomplex(b, rb) ;
+
+        return (a->r == b->r && a->i == b->i) ? Qtrue : Qfalse ;
+    }
+    else
+    {
+        doublereal br = (doublereal)NUM2DBL(rb) ;
+        return (a->r == br && a->i == ((doublereal)0.0)) ? Qtrue : Qfalse ;
+    }
+}
+
+void Init_dcomplex()
+{
+    /* Linalg */
+    rb_cLinalg = rb_define_module("Linalg") ;
+
+    rb_cDComplex = rb_define_class_under(rb_cLinalg, "DComplex", rb_cObject) ;
+
+    rb_define_alloc_func(rb_cDComplex, rb_dcomplex_allocate) ;
+    rb_define_method(rb_cDComplex, "initialize", rb_dcomplex_initialize, -1) ;
+    rb_define_method(rb_cDComplex, "real", rb_dcomplex_real, 0) ;
+    rb_define_method(rb_cDComplex, "imag", rb_dcomplex_imag, 0) ;
+    rb_define_method(rb_cDComplex, "+", rb_dcomplex_add, 1) ;
+    rb_define_method(rb_cDComplex, "-", rb_dcomplex_sub, 1) ;
+    rb_define_method(rb_cDComplex, "*", rb_dcomplex_mul, 1) ;
+    rb_define_method(rb_cDComplex, "/", rb_dcomplex_div, 1) ;
+    rb_define_method(rb_cDComplex, "conj", rb_dcomplex_conj, 0) ;
+    rb_define_method(rb_cDComplex, "abs", rb_dcomplex_abs, 0) ;
+    rb_define_method(rb_cDComplex, "abs2", rb_dcomplex_abs2, 0) ;
+    rb_define_method(rb_cDComplex, "within", rb_dcomplex_within, 2) ;
+    rb_define_method(rb_cDComplex, "coerce", rb_dcomplex_coerce, 1) ;
+    rb_define_method(rb_cDComplex, "to_doublecomplex_ptr",
+                     rb_dcomplex_to_doublecomplex_ptr, 0) ;
+    rb_define_method(rb_cDComplex, "==", rb_dcomplex_doubleequals, 1) ;
+}
+    
+

data/ext/linalg/dcomplex.h

@@ -0,0 +1,40 @@
+/*
+ * Copyright (c) 2004-2008 by James M. Lawrence
+ *
+ * See LICENSE
+ *
+ */
+
+#ifndef DCOMPLEX_H
+#define DCOMPLEX_H
+
+#include <stdlib.h>
+#include <math.h>
+
+#include <f2c.h>
+
+#include "ruby.h"
+
+#include "linalg.h"
+
+VALUE rb_dcomplex_new(doublecomplex c) ;
+doublecomplex rb_num2doublecomplex(VALUE num) ;
+
+VALUE rb_dcomplex_new(doublecomplex a) ;
+doublecomplex rb_num2doublecomplex(VALUE ra) ;
+VALUE rb_dcomplex_initialize(int argc, VALUE* argv, VALUE self) ;
+VALUE rb_dcomplex_real(VALUE self) ;
+VALUE rb_dcomplex_imag(VALUE self) ;
+VALUE rb_dcomplex_add(VALUE self, VALUE rb) ;
+VALUE rb_dcomplex_sub(VALUE self, VALUE rb) ;
+VALUE rb_dcomplex_mul(VALUE self, VALUE rb) ;
+VALUE rb_dcomplex_div(VALUE self, VALUE rb) ;
+VALUE rb_dcomplex_within(VALUE self, VALUE repsilon, VALUE rb) ;
+VALUE rb_dcomplex_conj(VALUE self) ;
+VALUE rb_dcomplex_abs(VALUE self) ;
+VALUE rb_dcomplex_abs2(VALUE self) ;
+VALUE rb_dcomplex_coerce(VALUE self, VALUE other) ;
+VALUE rb_dcomplex_to_doublecomplex_ptr(VALUE self) ;
+VALUE rb_dcomplex_doubleequals(VALUE self, VALUE rb) ;
+    
+#endif

data/ext/linalg/ddata.c

@@ -0,0 +1,194 @@
+/*
+ * Copyright (c) 2004-2008 by James M. Lawrence
+ *
+ * See LICENSE
+ *
+ */
+
+#include "xdata.h"
+
+struct DData_
+{
+    doublereal* data ;
+    int size ;
+} ;
+
+typedef struct DData_ DData ;
+
+VALUE rb_cDData ;
+
+#define get_ddata(ptr, obj) Data_Get_Struct(obj, DData, ptr)
+#define wrap_ddata(obj) Data_Wrap_Struct(rb_cDData, 0, DData_free, obj)
+
+void DData_free( DData* a )
+{
+    free(a->data) ;
+    free(a) ;
+}
+
+static VALUE rb_ddata_s_alloc(VALUE klass)
+{
+    DData* a ;
+    VALUE obj = Data_Make_Struct(klass,
+                                 DData,
+                                 0,
+                                 DData_free,
+                                 a) ;
+    a->data = 0 ;
+    a->size = 0 ;
+    return obj ;
+}
+
+/*
+ * call-seq:
+ *   new(size)
+ *   new(size) { |i| ... } 
+ *
+ * Create a contiguous array of LAPACK type <tt>doublereal</tt> of the
+ * given size, assigning elements to the block.  If no block is given,
+ * the data is left uninitialized.
+ *
+ */
+VALUE rb_ddata_initialize(VALUE self, VALUE size)
+{
+    DData* a ;
+    get_ddata(a, self) ;
+    a->size = NUM2INT(size) ;
+    a->data = (doublereal*)ALLOC_N(doublereal, a->size) ;
+
+    if( rb_block_given_p() )
+    {
+        int i ;
+        for( i = 0 ; i != a->size ; ++i )
+        {
+            VALUE rval = rb_yield(INT2FIX(i)) ;
+            a->data[i] = NUM2DBL(rval) ;
+        }
+    }
+    
+    return self ;
+}
+
+/*
+ * Array element read
+ *
+ */
+VALUE rb_ddata_aref(int argc, VALUE* argv, VALUE self)
+{
+    DData* a ;
+    VALUE rpos ;
+    int pos ;
+
+    rb_scan_args(argc, argv, "1", &rpos) ;
+    pos = NUM2INT(rpos) ;
+    get_ddata(a, self) ;
+
+    if( pos < 0 || pos >= a->size )
+    {
+        rb_raise(rb_eIndexError, "") ;
+    }
+
+    return rb_float_new((double)a->data[pos]) ;
+}
+
+/*
+ * Array element write
+ *
+ */
+VALUE rb_ddata_aset(int argc, VALUE* argv, VALUE self)
+{
+    DData* a ;
+    VALUE rpos ;
+    VALUE rval ;
+    int pos ;
+
+    rb_scan_args(argc, argv, "2", &rpos, &rval) ;
+    pos = NUM2INT(rpos) ;
+    get_ddata(a, self) ;
+
+    if( pos < 0 || pos >= a->size )
+    {
+        rb_raise(rb_eIndexError, "") ;
+    }
+
+    a->data[pos] = NUM2DBL(rval) ;
+
+    return rval ;
+}
+
+/*
+ * The entry point into the Lapack module.  Returns actual pointer
+ * value of the data.
+ *
+ */
+VALUE rb_ddata_to_doublereal_ptr( VALUE self )
+{
+    DData* a ;
+    get_ddata(a, self) ;
+    return ULONG2NUM((unsigned long)a->data) ;
+}
+
+/*
+ * Fill the array with this value.
+ *
+ */
+VALUE rb_ddata_fill( VALUE self, VALUE rval )
+{
+    DData* a ;
+    get_ddata(a, self) ;
+    
+    {
+        doublereal val = NUM2DBL(rval) ;
+        doublereal* p = a->data ;
+        doublereal* end = p + a->size ;
+        
+        for( ; p != end ; ++p )
+        {
+            *p = val ;
+        }
+    }
+
+    return self ;
+}
+
+/*
+ * For +Enumerable+
+ *
+ */
+VALUE rb_ddata_each( VALUE self )
+{
+    DData* a ;
+    get_ddata(a, self) ;
+    
+    {
+        doublereal* p = a->data ;
+        doublereal* end = p + a->size ;
+
+        for( ; p != end ; ++p )
+        {
+            rb_yield(rb_float_new((double)*p)) ;
+        }
+    }
+
+    return self ;
+}
+
+void Init_ddata()
+{
+    rb_cLinalg = rb_define_module("Linalg") ;
+    rb_cXData = rb_define_module_under(rb_cLinalg, "XData") ;
+    rb_cDData = rb_define_class_under(rb_cXData, "DData", rb_cObject) ;
+    rb_include_module(rb_cDData, rb_mEnumerable) ;
+
+    rb_define_alloc_func(rb_cDData, rb_ddata_s_alloc) ;
+
+    rb_define_method(rb_cDData, "initialize", rb_ddata_initialize, 1) ;
+    rb_define_method(rb_cDData, "[]", rb_ddata_aref, -1) ;
+    rb_define_method(rb_cDData, "[]=", rb_ddata_aset, -1) ;
+    rb_define_method(rb_cDData, "to_doublereal_ptr",
+                     rb_ddata_to_doublereal_ptr, 0) ;
+    rb_define_method(rb_cDData, "each", rb_ddata_each, 0) ;
+    rb_define_method(rb_cDData, "fill", rb_ddata_fill, 1) ;
+}
+
+