linalg 1.0.2

data/ext/linalg/xmatrix.h.tmpl

@@ -0,0 +1,77 @@
+/*
+ * Copyright (c) 2004-2008 by James M. Lawrence
+ *
+ * See LICENSE
+ *
+ */
+
+#ifndef CLASSUPPER_H
+#define CLASSUPPER_H
+
+#include <stdlib.h>
+#include <math.h>
+#include <time.h>
+
+#include <f2c.h>
+
+#include "BLAS.h"
+#include "LAPACK.h"
+
+#include "ruby.h"
+
+#include "dcomplex.h"
+#include "scomplex.h"
+
+#include "linalg.h"
+
+/**************************************************
+ *
+ * CLASSUPPER
+ *
+ **************************************************/
+
+struct CLASSUPPER_
+{
+    integer vsize ;
+    integer hsize ;
+    FORTRANTYPE* data ;
+} ;
+
+typedef struct CLASSUPPER_ CLASSUPPER ;
+
+/**************************************************
+ *
+ * globals
+ *
+ **************************************************/
+
+extern FORTRANTYPE CLASSLOWER_FORTRANTYPE_1 ;
+extern FORTRANTYPE CLASSLOWER_FORTRANTYPE_neg_1 ;
+extern FORTRANTYPE CLASSLOWER_FORTRANTYPE_0 ;
+extern VALUE rb_cCLASSUPPER ;
+
+/**************************************************
+ *
+ * utils
+ *
+ **************************************************/
+
+#define get_CLASSLOWER(ptr, obj) Data_Get_Struct(obj, CLASSUPPER, ptr)
+#define wrap_CLASSLOWER(obj) Data_Wrap_Struct(rb_cCLASSUPPER, 0, CLASSUPPER_free, obj)
+
+/**************************************************
+ *
+ * cross-defs
+ *
+ **************************************************/
+
+FORTRANTYPE CLASSUPPER_dot(CLASSUPPER* a, CLASSUPPER* b) ;
+CLASSUPPER* CLASSUPPER_rand(CLASSUPPER* a) ;
+VALUE rb_CLASSLOWER_within( VALUE self, VALUE repsilon, VALUE other ) ;
+VALUE rb_CLASSLOWER_symmetric_private( VALUE self, VALUE repsilon ) ;
+VALUE rb_CLASSLOWER_div(VALUE self, VALUE rb) ;
+CLASSUPPER* CLASSUPPER_mul_scalar(CLASSUPPER* a, FORTRANTYPE s) ;
+CLASSUPPER* CLASSUPPER_clone(CLASSUPPER* m) ;
+void CLASSUPPER_free(CLASSUPPER* m) ;
+    
+#endif

data/ext/linalg/xmatrixc.c.tmpl

@@ -0,0 +1,138 @@
+/*
+ * Copyright (c) 2004-2008 by James M. Lawrence
+ *
+ * See LICENSE
+ *
+ */
+
+#include "CLASSLOWER.h"
+
+FORTRANTYPE CLASSLOWER_FORTRANTYPE_1 = { 1.0, 0.0 } ;
+FORTRANTYPE CLASSLOWER_FORTRANTYPE_neg_1 = { -1.0, 0.0 } ;
+FORTRANTYPE CLASSLOWER_FORTRANTYPE_0 = { 0.0, 0.0 } ;
+
+static integer integer_1 = 1 ;
+
+FORTRANTYPE CLASSUPPER_dot(CLASSUPPER* a, CLASSUPPER* b)
+{
+    FORTRANTYPE ret ;
+    xdotc_(&ret,
+           &a->vsize,
+           a->data,
+           &integer_1,
+           b->data,
+           &integer_1) ;
+    return ret ;
+}
+
+
+CLASSUPPER* CLASSUPPER_rand(CLASSUPPER* a)
+{
+    integer i ;
+    integer size = a->vsize*a->hsize ;
+
+    for( i = 0 ; i != size ; ++i )
+    {
+        (a->data[i]).r =
+            2.0*(((double)rand())/(RAND_MAX)) - 1.0 ;
+        (a->data[i]).i =
+            2.0*(((double)rand())/(RAND_MAX)) - 1.0 ;
+    }
+
+    return a ;
+}
+
+
+VALUE rb_CLASSLOWER_within( VALUE self, VALUE repsilon, VALUE other )
+{
+    CLASSUPPER* a ;
+    CLASSUPPER* b ;
+    FORTRANTYPE* pa ;
+    FORTRANTYPE* pb ;
+    FORTRANTYPE* aend ;
+    double epsilon ;
+    get_CLASSLOWER(a, self) ;
+    get_CLASSLOWER(b, other) ;
+
+    if( a->vsize != b->vsize ||
+        a->hsize != b->hsize )
+    {
+        raise_dim_error() ;
+    }
+
+    epsilon = NUM2DBL(repsilon) ;
+    
+    pa = a->data ;
+    pb = b->data ;
+    aend = pa + a->vsize*a->hsize ;
+    
+    for( ; pa != aend ; ++pa, ++pb )
+    {
+        if( fabs(pa->r - pb->r) > epsilon ||
+            fabs(pa->i - pb->i) > epsilon )
+        {
+            return Qfalse ;
+        }
+    }
+
+    return Qtrue ;
+}
+
+VALUE rb_CLASSLOWER_symmetric_private( VALUE self, VALUE repsilon )
+{
+    CLASSUPPER* a ;
+    double epsilon ;
+    
+    get_CLASSLOWER(a, self) ;
+    
+    if( a->vsize != a->hsize )
+    {
+        return Qfalse ;
+    }
+
+    epsilon = NUM2DBL(repsilon) ;
+
+    {
+        int i ;
+        int j ;
+
+        for( j = 0 ; j < a->hsize ; ++j )
+        {
+            for( i = j + 1 ; i < a->vsize ; ++i )
+            {
+                if( fabs(a->data[i + j*a->vsize].r -
+                         a->data[j + i*a->vsize].r) > epsilon ||
+                    fabs(a->data[i + j*a->vsize].i -
+                         a->data[j + i*a->vsize].i) > epsilon )
+                {
+                    return Qfalse ;
+                }
+            }
+        }
+    }
+
+    return Qtrue ;
+}
+
+VALUE rb_CLASSLOWER_div(VALUE self, VALUE rb)
+{
+    CLASSUPPER* a ;
+    CLASSUPPER* c ;
+    FORTRANTYPE b ;
+    FORTRANTYPE s ;
+    doublereal bottom ;
+    VALUE rc ;
+    
+    b = RUBY2FORTRAN(rb) ;
+
+    get_CLASSLOWER(a, self) ;
+    c = CLASSUPPER_clone(a) ;
+    rc = wrap_CLASSLOWER(c) ;
+    
+    bottom = b.r*b.r + b.i*b.i ;
+    s.r = b.r/bottom ;
+    s.i = -b.i/bottom ;
+    
+    CLASSUPPER_mul_scalar(c, s) ;
+    return rc ;
+}

data/ext/linalg/xmatrixr.c.tmpl

@@ -0,0 +1,130 @@
+/*
+ * Copyright (c) 2004-2008 by James M. Lawrence
+ *
+ * See LICENSE
+ *
+ */
+
+#include "CLASSLOWER.h"
+
+FORTRANTYPE CLASSLOWER_FORTRANTYPE_1 = 1.0 ;
+FORTRANTYPE CLASSLOWER_FORTRANTYPE_neg_1 = -1.0 ;
+FORTRANTYPE CLASSLOWER_FORTRANTYPE_0 = 0.0 ;
+
+static integer integer_1 = 1 ;
+
+FORTRANTYPE CLASSUPPER_dot(CLASSUPPER* a, CLASSUPPER* b)
+{
+    return xdot_(&a->vsize,
+                 a->data,
+                 &integer_1,
+                 b->data,
+                 &integer_1) ;
+}
+
+
+CLASSUPPER* CLASSUPPER_rand(CLASSUPPER* a)
+{
+    integer i ;
+    integer size = a->vsize*a->hsize ;
+
+    for( i = 0 ; i != size ; ++i )
+    {
+        a->data[i] =
+            2.0*(((double)rand())/(RAND_MAX)) - CLASSLOWER_FORTRANTYPE_1 ;
+    }
+
+    return a ;
+}
+
+
+/*
+ * call-seq: within(epsilon, other)
+ *
+ * Test if each matrix element is within +epsilon+ of the respective
+ * matrix element of +other+.
+ *
+ */
+VALUE rb_CLASSLOWER_within( VALUE self, VALUE repsilon, VALUE other )
+{
+    CLASSUPPER* a ;
+    CLASSUPPER* b ;
+    FORTRANTYPE* pa ;
+    FORTRANTYPE* pb ;
+    FORTRANTYPE* aend ;
+    double epsilon ;
+    get_CLASSLOWER(a, self) ;
+    get_CLASSLOWER(b, other) ;
+
+    if( a->vsize != b->vsize ||
+        a->hsize != b->hsize )
+    {
+        raise_dim_error() ;
+    }
+
+    epsilon = NUM2DBL(repsilon) ;
+    
+    pa = a->data ;
+    pb = b->data ;
+    aend = pa + a->vsize*a->hsize ;
+    
+    for( ; pa != aend ; ++pa, ++pb )
+    {
+        if( fabs((*pa) - (*pb)) > epsilon )
+        {
+            return Qfalse ;
+        }
+    }
+
+    return Qtrue ;
+}
+
+
+VALUE rb_CLASSLOWER_symmetric_private( VALUE self, VALUE repsilon )
+{
+    CLASSUPPER* a ;
+    double epsilon ;
+    
+    get_CLASSLOWER(a, self) ;
+    
+    if( a->vsize != a->hsize )
+    {
+        return Qfalse ;
+    }
+
+    epsilon = NUM2DBL(repsilon) ;
+
+    {
+        int i ;
+        int j ;
+
+        for( j = 0 ; j < a->hsize ; ++j )
+        {
+            for( i = j + 1 ; i < a->vsize ; ++i )
+            {
+                if( fabs(a->data[i + j*a->vsize] -
+                         a->data[j + i*a->vsize]) > epsilon )
+                {
+                    return Qfalse ;
+                }
+            }
+        }
+    }
+
+    return Qtrue ;
+}
+
+VALUE rb_CLASSLOWER_div(VALUE self, VALUE rb)
+{
+    CLASSUPPER* a ;
+    CLASSUPPER* c ;
+    VALUE rc ;
+    double b = NUM2DBL(rb) ;
+    
+    get_CLASSLOWER(a, self) ;
+    c = CLASSUPPER_clone(a) ;
+    rc = wrap_CLASSLOWER(c) ;
+    CLASSUPPER_mul_scalar(c, 1.0/b) ;
+    return rc ;
+}
+

data/lib/lapack.rb

@@ -0,0 +1,87 @@
+#
+# Copyright (c) 2004-2008 by James M. Lawrence
+#
+# See LICENSE
+#
+
+require 'rbconfig'
+
+require "lapack.#{Config::CONFIG['DLEXT']}"
+
+#
+# Simple, strongly-typed bindings to LAPACK.
+#
+# Every LAPACK subroutine is accessible from the +Lapack+ module
+#
+#   Lapack.methods.size  # => 1498
+#
+# and each subroutine corresponds to a +Lapack+ module method
+# of the same name
+#
+#   Lapack.methods.include? "dgemm"  # => true
+#
+# The +Lapack+ module knows the type signature of each LAPACK
+# subroutine.  With this signature it calls the appropriate method:
+#
+#    to_real_ptr
+#    to_doublereal_ptr
+#    to_complex_ptr
+#    to_doublecomplex_ptr
+#    to_integer_ptr
+#    to_logical_ptr
+#    to_L_fp_ptr
+#    to_char_ptr
+#
+# on each parameter passed.  For example,
+# 
+#   Lapack.dgemm(transa,  # calls transa.to_integer_ptr
+#                transb,  # calls transb.to_integer_ptr
+#                m,       # calls m.to_integer_ptr
+#                n,       # calls n.to_integer_ptr
+#                k,       # calls k.to_integer_ptr
+#                alpha,   # calls alpha.to_doublereal_ptr
+#                a,       # calls a.to_doublereal_ptr
+#                lda,     # calls lda.to_integer_ptr
+#                b,       # calls b.to_doublereal_ptr
+#                ldb,     # calls b.to_integer_ptr
+#                beta,    # calls beta.to_doublereal_ptr
+#                c,       # calls c.to_doublereal_ptr
+#                ldc)     # calls ldc.to_integer_ptr
+# 
+# The type names are taken directly from g2c.h.
+#
+#    real
+#    doublereal
+#    complex
+#    doublecomplex
+#    integer
+#    logical
+#    L_fp
+#    char
+#
+# Each <tt>to_FORTRANTYPE_ptr</tt> method returns the actual pointer
+# value of some data.
+#
+# Where do you find classes which so promiscuously expose pointer
+# values?  Well, you make them from your own extension classes, or you
+# may use some generic classes which are provided.  See Linalg::XData
+# for some very simple data classes.
+#
+# It should be emphasized that there is no preferred class or data
+# structure for interacting with the +Lapack+ module.  All +Lapack+
+# requires is that the appropriate to_FORTRANTYPE_ptr be implemented
+# on each parameter passed.  From this perspective it is questionable
+# whether +Lapack+ should even be bundled with the +linalg+ package.
+#
+# +DMatrix+, for example, is just a class which implements
+# the <tt>to_doublereal_ptr</tt> method, and the entirety of its
+# communication from ruby to +Lapack+ goes through that method.
+#
+# For C extension writers: While C's +double+, for example, is almost
+# surely the same as +doublereal+, to ensure portability it is
+# generally good practice to use the aforementioned types found in the
+# g2c.h header on your system.
+#
+#
+module Lapack
+end

data/lib/linalg.rb

@@ -0,0 +1,9 @@
+require "linalg.#{RbConfig::CONFIG['DLEXT']}"
+require "lapack.#{RbConfig::CONFIG['DLEXT']}"
+require "linalg/dcomplex"
+require "linalg/dmatrix"
+require "linalg/exception"
+require "linalg/iterators"
+require "linalg/math"
+require "linalg/scomplex"
+require "linalg/xdata"

data/lib/linalg/dcomplex.rb

@@ -0,0 +1,17 @@
+#
+# Copyright (c) 2004-2008 by James M. Lawrence
+#
+# See LICENSE
+#
+
+require 'linalg'
+
+module Linalg
+   class DComplex
+      def to_s
+         "#{real} + #{imag}i"
+      end
+   end
+end
+
+