nnls 0.0.1

data/README.md

@@ -0,0 +1,18 @@
+Non-negative Less Square Algorithm
+===================
+
+It's a C. Lawson and R. Hanson Fortran 77 code published in
+["Solving Least Squares Problems"](http://books.google.com/books?id=ROw4hU85nz8C&lpg=PA261&ots=mj7CFK4GNo&dq=mda%20is%20the%20first%20dimensioning%20parameter&pg=PP1#v=onepage&q&f=false) translated to C code and binded to Ruby.
+
+Usage
+----------
+
+    $ gem install nnls
+
+    a = [0.5, 0.3, 0.2,
+         0.2, 0.7, 0.8]
+
+    b = [0.1, 0.1, 0.7]
+
+    result = NNLS.nnls(a, b, 2, 3)
+    => [[0.05263157894736844, 0.0, 0.10526315789473684], 0.0]

data/Rakefile

@@ -0,0 +1,25 @@
+require 'rake/testtask'
+
+begin
+  require 'jeweler'
+
+  Jeweler::Tasks.new do |gemspec|
+    gemspec.name = "nnls"
+    gemspec.summary = "Non-negative Less Square Algorithm"
+    gemspec.description = "Ruby bindings for C. Lawson and R. Hanson 'Non-negative Less Square' algorithm implementation."
+    gemspec.email = "sotakone@sotakone.com"
+    gemspec.homepage = "http://github.com/sotakone/nnls/"
+    gemspec.authors = ["Mikhail Lapshin"]
+    gemspec.files.include 'lib/nnls.rb'
+    gemspec.files.include 'ext/nnls/*.c'
+    gemspec.files.include 'ext/nnls/extconf.rb'
+  end
+
+  Jeweler::GemcutterTasks.new
+rescue LoadError
+  puts "Jeweler not available. Install it with: gem install jeweler"
+end
+
+Rake::TestTask.new(:test) do |t|
+  t.test_files = FileList['test/*_test.rb']
+end

data/VERSION

@@ -0,0 +1 @@
+0.0.1

data/ext/nnls/extconf.rb

@@ -0,0 +1,7 @@
+require 'mkmf'
+extension_name = 'nnls'
+dir_config(extension_name)
+
+# $CFLAGS << ' -g'
+
+create_makefile(extension_name)

data/ext/nnls/impl.c

@@ -0,0 +1,764 @@
+/* $Id: nnls.c,v 1.7 2000/11/07 16:29:30 tgkolda Exp $ */
+/* $Source: /usr/local/cvsroot/appspack/apps/src/nnls.c,v $ */
+
+/* Distributed with ASYNCHRONOUS PARALLEL PATTERN SEARCH (APPS) */
+
+/* The routines in this file have been translated from Fortran to C by
+   f2c. Additional modifications have been made to remove the
+   dependencies on the f2c header file and library. The original
+   Fortran 77 code accompanies the SIAM Publications printing of
+   "Solving Least Squares Problems," by C. Lawson and R. Hanson and is
+   freely available at www.netlib.org/lawson-hanson/all. */
+
+/* nnls.F -- translated by f2c (version 19970805).
+   You must link the resulting object file with the libraries:
+	-lf2c -lm   (in that order)
+*/
+
+/* The next line was removed after the f2c translation */
+/* #include "f2c.h" */
+
+/* The next lines were added after the f2c translation. Also swapped
+   abs for nnls_abs and max for nnls_max to avoid confusion with some
+   compilers. */
+#include <stdio.h>
+#include <math.h>
+#define nnls_max(a,b) ((a) >= (b) ? (a) : (b))
+#define nnls_abs(x) ((x) >= 0 ? (x) : -(x))
+typedef int integer;
+typedef double doublereal;
+
+/* The following subroutine was added after the f2c translation */
+double d_sign(double *a, double *b)
+{
+  double x;
+  x = (*a >= 0 ? *a : - *a);
+  return( *b >= 0 ? x : -x);
+}
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c__0 = 0;
+static integer c__2 = 2;
+
+/*     SUBROUTINE NNLS  (A,MDA,M,N,B,X,RNORM,W,ZZ,INDEX,MODE) */
+
+/*  Algorithm NNLS: NONNEGATIVE LEAST SQUARES */
+
+/*  The original version of this code was developed by */
+/*  Charles L. Lawson and Richard J. Hanson at Jet Propulsion Laboratory */
+/*  1973 JUN 15, and published in the book */
+/*  "SOLVING LEAST SQUARES PROBLEMS", Prentice-HalL, 1974. */
+/*  Revised FEB 1995 to accompany reprinting of the book by SIAM. */
+
+/*     GIVEN AN M BY N MATRIX, A, AND AN M-VECTOR, B,  COMPUTE AN */
+/*     N-VECTOR, X, THAT SOLVES THE LEAST SQUARES PROBLEM */
+
+/*                      A * X = B  SUBJECT TO X .GE. 0 */
+/*     ------------------------------------------------------------------ */
+/*                     Subroutine Arguments */
+
+/*     A(),MDA,M,N     MDA IS THE FIRST DIMENSIONING PARAMETER FOR THE */
+/*                     ARRAY, A().   ON ENTRY A() CONTAINS THE M BY N */
+/*                     MATRIX, A.           ON EXIT A() CONTAINS */
+/*                     THE PRODUCT MATRIX, Q*A , WHERE Q IS AN */
+/*                     M BY M ORTHOGONAL MATRIX GENERATED IMPLICITLY BY */
+/*                     THIS SUBROUTINE. */
+/*     B()     ON ENTRY B() CONTAINS THE M-VECTOR, B.   ON EXIT B() CON- */
+/*             TAINS Q*B. */
+/*     X()     ON ENTRY X() NEED NOT BE INITIALIZED.  ON EXIT X() WILL */
+/*             CONTAIN THE SOLUTION VECTOR. */
+/*     RNORM   ON EXIT RNORM CONTAINS THE EUCLIDEAN NORM OF THE */
+/*             RESIDUAL VECTOR. */
+/*     W()     AN N-ARRAY OF WORKING SPACE.  ON EXIT W() WILL CONTAIN */
+/*             THE DUAL SOLUTION VECTOR.   W WILL SATISFY W(I) = 0. */
+/*             FOR ALL I IN SET P  AND W(I) .LE. 0. FOR ALL I IN SET Z */
+/*     ZZ()     AN M-ARRAY OF WORKING SPACE. */
+/*     INDEX()     AN INTEGER WORKING ARRAY OF LENGTH AT LEAST N. */
+/*                 ON EXIT THE CONTENTS OF THIS ARRAY DEFINE THE SETS */
+/*                 P AND Z AS FOLLOWS.. */
+
+/*                 INDEX(1)   THRU INDEX(NSETP) = SET P. */
+/*                 INDEX(IZ1) THRU INDEX(IZ2)   = SET Z. */
+/*                 IZ1 = NSETP + 1 = NPP1 */
+/*                 IZ2 = N */
+/*     MODE    THIS IS A SUCCESS-FAILURE FLAG WITH THE FOLLOWING */
+/*             MEANINGS. */
+/*             1     THE SOLUTION HAS BEEN COMPUTED SUCCESSFULLY. */
+/*             2     THE DIMENSIONS OF THE PROBLEM ARE BAD. */
+/*                   EITHER M .LE. 0 OR N .LE. 0. */
+/*             3    ITERATION COUNT EXCEEDED.  MORE THAN 3*N ITERATIONS. */
+
+/*     ------------------------------------------------------------------ */
+/* Subroutine */ int nnls_(a, mda, m, n, b, x, rnorm, w, zz, index, mode)
+doublereal *a;
+integer *mda, *m, *n;
+doublereal *b, *x, *rnorm, *w, *zz;
+integer *index, *mode;
+{
+    /* System generated locals */
+    integer a_dim1, a_offset, i__1, i__2;
+    doublereal d__1, d__2;
+
+    /* Builtin functions */
+    /* The following lines were commented out after the f2c translation */
+    /* double sqrt(); */
+    /* integer s_wsfe(), do_fio(), e_wsfe(); */
+
+    /* Local variables */
+    extern doublereal diff_();
+    static integer iter;
+    static doublereal temp, wmax;
+    static integer i__, j, l;
+    static doublereal t, alpha, asave;
+    static integer itmax, izmax, nsetp;
+    extern /* Subroutine */ int g1_();
+    static doublereal dummy, unorm, ztest, cc;
+    extern /* Subroutine */ int h12_();
+    static integer ii, jj, ip;
+    static doublereal sm;
+    static integer iz, jz;
+    static doublereal up, ss;
+    static integer rtnkey, iz1, iz2, npp1;
+
+    /* Fortran I/O blocks */
+    /* The following line was commented out after the f2c translation */
+    /* static cilist io___22 = { 0, 6, 0, "(/a)", 0 }; */
+
+
+/*     ------------------------------------------------------------------ 
+*/
+/*     integer INDEX(N) */
+/*     double precision A(MDA,N), B(M), W(N), X(N), ZZ(M) */
+/*     ------------------------------------------------------------------ 
+*/
+    /* Parameter adjustments */
+    a_dim1 = *mda;
+    a_offset = a_dim1 + 1;
+    a -= a_offset;
+    --b;
+    --x;
+    --w;
+    --zz;
+    --index;
+
+    /* Function Body */
+    *mode = 1;
+    if (*m <= 0 || *n <= 0) {
+	*mode = 2;
+	return 0;
+    }
+    iter = 0;
+    itmax = *n * 3;
+
+/*                    INITIALIZE THE ARRAYS INDEX() AND X(). */
+
+    i__1 = *n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	x[i__] = 0.;
+/* L20: */
+	index[i__] = i__;
+    }
+
+    iz2 = *n;
+    iz1 = 1;
+    nsetp = 0;
+    npp1 = 1;
+/*                             ******  MAIN LOOP BEGINS HERE  ****** */
+L30:
+/*                  QUIT IF ALL COEFFICIENTS ARE ALREADY IN THE SOLUTION. 
+*/
+/*                        OR IF M COLS OF A HAVE BEEN TRIANGULARIZED. */
+
+    if (iz1 > iz2 || nsetp >= *m) {
+	goto L350;
+    }
+
+/*         COMPUTE COMPONENTS OF THE DUAL (NEGATIVE GRADIENT) VECTOR W(). 
+*/
+
+    i__1 = iz2;
+    for (iz = iz1; iz <= i__1; ++iz) {
+	j = index[iz];
+	sm = 0.;
+	i__2 = *m;
+	for (l = npp1; l <= i__2; ++l) {
+/* L40: */
+	    sm += a[l + j * a_dim1] * b[l];
+	}
+	w[j] = sm;
+/* L50: */
+    }
+/*                                   FIND LARGEST POSITIVE W(J). */
+L60:
+    wmax = 0.;
+    i__1 = iz2;
+    for (iz = iz1; iz <= i__1; ++iz) {
+	j = index[iz];
+	if (w[j] > wmax) {
+	    wmax = w[j];
+	    izmax = iz;
+	}
+/* L70: */
+    }
+
+/*             IF WMAX .LE. 0. GO TO TERMINATION. */
+/*             THIS INDICATES SATISFACTION OF THE KUHN-TUCKER CONDITIONS. 
+*/
+
+    if (wmax <= 0.) {
+	goto L350;
+    }
+    iz = izmax;
+    j = index[iz];
+
+/*     THE SIGN OF W(J) IS OK FOR J TO BE MOVED TO SET P. */
+/*     BEGIN THE TRANSFORMATION AND CHECK NEW DIAGONAL ELEMENT TO AVOID */
+/*     NEAR LINEAR DEPENDENCE. */
+
+    asave = a[npp1 + j * a_dim1];
+    i__1 = npp1 + 1;
+    h12_(&c__1, &npp1, &i__1, m, &a[j * a_dim1 + 1], &c__1, &up, &dummy, &
+	    c__1, &c__1, &c__0);
+    unorm = 0.;
+    if (nsetp != 0) {
+	i__1 = nsetp;
+	for (l = 1; l <= i__1; ++l) {
+/* L90: */
+/* Computing 2nd power */
+	    d__1 = a[l + j * a_dim1];
+	    unorm += d__1 * d__1;
+	}
+    }
+    unorm = sqrt(unorm);
+    d__2 = unorm + (d__1 = a[npp1 + j * a_dim1], nnls_abs(d__1)) * .01;
+    if (diff_(&d__2, &unorm) > 0.) {
+
+/*        COL J IS SUFFICIENTLY INDEPENDENT.  COPY B INTO ZZ, UPDATE Z
+Z */
+/*        AND SOLVE FOR ZTEST ( = PROPOSED NEW VALUE FOR X(J) ). */
+
+	i__1 = *m;
+	for (l = 1; l <= i__1; ++l) {
+/* L120: */
+	    zz[l] = b[l];
+	}
+	i__1 = npp1 + 1;
+	h12_(&c__2, &npp1, &i__1, m, &a[j * a_dim1 + 1], &c__1, &up, &zz[1], &
+		c__1, &c__1, &c__1);
+	ztest = zz[npp1] / a[npp1 + j * a_dim1];
+
+/*                                     SEE IF ZTEST IS POSITIVE */
+
+	if (ztest > 0.) {
+	    goto L140;
+	}
+    }
+
+/*     REJECT J AS A CANDIDATE TO BE MOVED FROM SET Z TO SET P. */
+/*     RESTORE A(NPP1,J), SET W(J)=0., AND LOOP BACK TO TEST DUAL */
+/*     COEFFS AGAIN. */
+
+    a[npp1 + j * a_dim1] = asave;
+    w[j] = 0.;
+    goto L60;
+
+/*     THE INDEX  J=INDEX(IZ)  HAS BEEN SELECTED TO BE MOVED FROM */
+/*     SET Z TO SET P.    UPDATE B,  UPDATE INDICES,  APPLY HOUSEHOLDER */
+/*     TRANSFORMATIONS TO COLS IN NEW SET Z,  ZERO SUBDIAGONAL ELTS IN */
+/*     COL J,  SET W(J)=0. */
+
+L140:
+    i__1 = *m;
+    for (l = 1; l <= i__1; ++l) {
+/* L150: */
+	b[l] = zz[l];
+    }
+
+    index[iz] = index[iz1];
+    index[iz1] = j;
+    ++iz1;
+    nsetp = npp1;
+    ++npp1;
+
+    if (iz1 <= iz2) {
+	i__1 = iz2;
+	for (jz = iz1; jz <= i__1; ++jz) {
+	    jj = index[jz];
+	    h12_(&c__2, &nsetp, &npp1, m, &a[j * a_dim1 + 1], &c__1, &up, &a[
+		    jj * a_dim1 + 1], &c__1, mda, &c__1);
+/* L160: */
+	}
+    }
+
+    if (nsetp != *m) {
+	i__1 = *m;
+	for (l = npp1; l <= i__1; ++l) {
+/* L180: */
+	    a[l + j * a_dim1] = 0.;
+	}
+    }
+
+    w[j] = 0.;
+/*                                SOLVE THE TRIANGULAR SYSTEM. */
+/*                                STORE THE SOLUTION TEMPORARILY IN ZZ(). 
+*/
+    rtnkey = 1;
+    goto L400;
+L200:
+
+/*                       ******  SECONDARY LOOP BEGINS HERE ****** */
+
+/*                          ITERATION COUNTER. */
+
+L210:
+    ++iter;
+    if (iter > itmax) {
+	*mode = 3;
+	/* The following lines were replaced after the f2c translation */
+	/* s_wsfe(&io___22); */
+	/* do_fio(&c__1, " NNLS quitting on iteration count.", 34L); */
+	/* e_wsfe(); */
+	fprintf(stdout, "\n NNLS quitting on iteration count.\n");
+	fflush(stdout);
+	goto L350;
+    }
+
+/*                    SEE IF ALL NEW CONSTRAINED COEFFS ARE FEASIBLE. */
+/*                                  IF NOT COMPUTE ALPHA. */
+
+    alpha = 2.;
+    i__1 = nsetp;
+    for (ip = 1; ip <= i__1; ++ip) {
+	l = index[ip];
+	if (zz[ip] <= 0.) {
+	    t = -x[l] / (zz[ip] - x[l]);
+	    if (alpha > t) {
+		alpha = t;
+		jj = ip;
+	    }
+	}
+/* L240: */
+    }
+
+/*          IF ALL NEW CONSTRAINED COEFFS ARE FEASIBLE THEN ALPHA WILL */
+/*          STILL = 2.    IF SO EXIT FROM SECONDARY LOOP TO MAIN LOOP. */
+
+    if (alpha == 2.) {
+	goto L330;
+    }
+
+/*          OTHERWISE USE ALPHA WHICH WILL BE BETWEEN 0. AND 1. TO */
+/*          INTERPOLATE BETWEEN THE OLD X AND THE NEW ZZ. */
+
+    i__1 = nsetp;
+    for (ip = 1; ip <= i__1; ++ip) {
+	l = index[ip];
+	x[l] += alpha * (zz[ip] - x[l]);
+/* L250: */
+    }
+
+/*        MODIFY A AND B AND THE INDEX ARRAYS TO MOVE COEFFICIENT I */
+/*        FROM SET P TO SET Z. */
+
+    i__ = index[jj];
+L260:
+    x[i__] = 0.;
+
+    if (jj != nsetp) {
+	++jj;
+	i__1 = nsetp;
+	for (j = jj; j <= i__1; ++j) {
+	    ii = index[j];
+	    index[j - 1] = ii;
+	    g1_(&a[j - 1 + ii * a_dim1], &a[j + ii * a_dim1], &cc, &ss, &a[j 
+		    - 1 + ii * a_dim1]);
+	    a[j + ii * a_dim1] = 0.;
+	    i__2 = *n;
+	    for (l = 1; l <= i__2; ++l) {
+		if (l != ii) {
+
+/*                 Apply procedure G2 (CC,SS,A(J-1,L),A(J,
+L)) */
+
+		    temp = a[j - 1 + l * a_dim1];
+		    a[j - 1 + l * a_dim1] = cc * temp + ss * a[j + l * a_dim1]
+			    ;
+		    a[j + l * a_dim1] = -ss * temp + cc * a[j + l * a_dim1];
+		}
+/* L270: */
+	    }
+
+/*                 Apply procedure G2 (CC,SS,B(J-1),B(J)) */
+
+	    temp = b[j - 1];
+	    b[j - 1] = cc * temp + ss * b[j];
+	    b[j] = -ss * temp + cc * b[j];
+/* L280: */
+	}
+    }
+
+    npp1 = nsetp;
+    --nsetp;
+    --iz1;
+    index[iz1] = i__;
+
+/*        SEE IF THE REMAINING COEFFS IN SET P ARE FEASIBLE.  THEY SHOULD 
+*/
+/*        BE BECAUSE OF THE WAY ALPHA WAS DETERMINED. */
+/*        IF ANY ARE INFEASIBLE IT IS DUE TO ROUND-OFF ERROR.  ANY */
+/*        THAT ARE NONPOSITIVE WILL BE SET TO ZERO */
+/*        AND MOVED FROM SET P TO SET Z. */
+
+    i__1 = nsetp;
+    for (jj = 1; jj <= i__1; ++jj) {
+	i__ = index[jj];
+	if (x[i__] <= 0.) {
+	    goto L260;
+	}
+/* L300: */
+    }
+
+/*         COPY B( ) INTO ZZ( ).  THEN SOLVE AGAIN AND LOOP BACK. */
+
+    i__1 = *m;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+/* L310: */
+	zz[i__] = b[i__];
+    }
+    rtnkey = 2;
+    goto L400;
+L320:
+    goto L210;
+/*                      ******  END OF SECONDARY LOOP  ****** */
+
+L330:
+    i__1 = nsetp;
+    for (ip = 1; ip <= i__1; ++ip) {
+	i__ = index[ip];
+/* L340: */
+	x[i__] = zz[ip];
+    }
+/*        ALL NEW COEFFS ARE POSITIVE.  LOOP BACK TO BEGINNING. */
+    goto L30;
+
+/*                        ******  END OF MAIN LOOP  ****** */
+
+/*                        COME TO HERE FOR TERMINATION. */
+/*                     COMPUTE THE NORM OF THE FINAL RESIDUAL VECTOR. */
+
+L350:
+    sm = 0.;
+    if (npp1 <= *m) {
+	i__1 = *m;
+	for (i__ = npp1; i__ <= i__1; ++i__) {
+/* L360: */
+/* Computing 2nd power */
+	    d__1 = b[i__];
+	    sm += d__1 * d__1;
+	}
+    } else {
+	i__1 = *n;
+	for (j = 1; j <= i__1; ++j) {
+/* L380: */
+	    w[j] = 0.;
+	}
+    }
+    *rnorm = sqrt(sm);
+    return 0;
+
+/*     THE FOLLOWING BLOCK OF CODE IS USED AS AN INTERNAL SUBROUTINE */
+/*     TO SOLVE THE TRIANGULAR SYSTEM, PUTTING THE SOLUTION IN ZZ(). */
+
+L400:
+    i__1 = nsetp;
+    for (l = 1; l <= i__1; ++l) {
+	ip = nsetp + 1 - l;
+	if (l != 1) {
+	    i__2 = ip;
+	    for (ii = 1; ii <= i__2; ++ii) {
+		zz[ii] -= a[ii + jj * a_dim1] * zz[ip + 1];
+/* L410: */
+	    }
+	}
+	jj = index[ip];
+	zz[ip] /= a[ip + jj * a_dim1];
+/* L430: */
+    }
+    switch ((int)rtnkey) {
+	case 1:  goto L200;
+	case 2:  goto L320;
+    }
+
+    /* The next line was added after the f2c translation to keep
+       compilers from complaining about a void return from a non-void
+       function. */
+    return 0;
+
+} /* nnls_ */
+
+/* Subroutine */ int g1_(a, b, cterm, sterm, sig)
+doublereal *a, *b, *cterm, *sterm, *sig;
+{
+    /* System generated locals */
+    doublereal d__1;
+
+    /* Builtin functions */
+    /* The following line was commented out after the f2c translation */
+    /* double sqrt(), d_sign(); */
+
+    /* Local variables */
+    static doublereal xr, yr;
+
+
+/*     COMPUTE ORTHOGONAL ROTATION MATRIX.. */
+
+/*  The original version of this code was developed by */
+/*  Charles L. Lawson and Richard J. Hanson at Jet Propulsion Laboratory 
+*/
+/*  1973 JUN 12, and published in the book */
+/*  "SOLVING LEAST SQUARES PROBLEMS", Prentice-HalL, 1974. */
+/*  Revised FEB 1995 to accompany reprinting of the book by SIAM. */
+
+/*     COMPUTE.. MATRIX   (C, S) SO THAT (C, S)(A) = (SQRT(A**2+B**2)) */
+/*                        (-S,C)         (-S,C)(B)   (   0          ) */
+/*     COMPUTE SIG = SQRT(A**2+B**2) */
+/*        SIG IS COMPUTED LAST TO ALLOW FOR THE POSSIBILITY THAT */
+/*        SIG MAY BE IN THE SAME LOCATION AS A OR B . */
+/*     ------------------------------------------------------------------ 
+*/
+/*     ------------------------------------------------------------------ 
+*/
+    if (nnls_abs(*a) > nnls_abs(*b)) {
+	xr = *b / *a;
+/* Computing 2nd power */
+	d__1 = xr;
+	yr = sqrt(d__1 * d__1 + 1.);
+	d__1 = 1. / yr;
+	*cterm = d_sign(&d__1, a);
+	*sterm = *cterm * xr;
+	*sig = nnls_abs(*a) * yr;
+	return 0;
+    }
+    if (*b != 0.) {
+	xr = *a / *b;
+/* Computing 2nd power */
+	d__1 = xr;
+	yr = sqrt(d__1 * d__1 + 1.);
+	d__1 = 1. / yr;
+	*sterm = d_sign(&d__1, b);
+	*cterm = *sterm * xr;
+	*sig = nnls_abs(*b) * yr;
+	return 0;
+    }
+    *sig = 0.;
+    *cterm = 0.;
+    *sterm = 1.;
+    return 0;
+} /* g1_ */
+
+/*     SUBROUTINE H12 (MODE,LPIVOT,L1,M,U,IUE,UP,C,ICE,ICV,NCV) */
+
+/*  CONSTRUCTION AND/OR APPLICATION OF A SINGLE */
+/*  HOUSEHOLDER TRANSFORMATION..     Q = I + U*(U**T)/B */
+
+/*  The original version of this code was developed by */
+/*  Charles L. Lawson and Richard J. Hanson at Jet Propulsion Laboratory */
+/*  1973 JUN 12, and published in the book */
+/*  "SOLVING LEAST SQUARES PROBLEMS", Prentice-HalL, 1974. */
+/*  Revised FEB 1995 to accompany reprinting of the book by SIAM. */
+/*     ------------------------------------------------------------------ */
+/*                     Subroutine Arguments */
+
+/*     MODE   = 1 OR 2   Selects Algorithm H1 to construct and apply a */
+/*            Householder transformation, or Algorithm H2 to apply a */
+/*            previously constructed transformation. */
+/*     LPIVOT IS THE INDEX OF THE PIVOT ELEMENT. */
+/*     L1,M   IF L1 .LE. M   THE TRANSFORMATION WILL BE CONSTRUCTED TO */
+/*            ZERO ELEMENTS INDEXED FROM L1 THROUGH M.   IF L1 GT. M */
+/*            THE SUBROUTINE DOES AN IDENTITY TRANSFORMATION. */
+/*     U(),IUE,UP    On entry with MODE = 1, U() contains the pivot */
+/*            vector.  IUE is the storage increment between elements. */
+/*            On exit when MODE = 1, U() and UP contain quantities */
+/*            defining the vector U of the Householder transformation. */
+/*            on entry with MODE = 2, U() and UP should contain */
+/*            quantities previously computed with MODE = 1.  These will */
+/*            not be modified during the entry with MODE = 2. */
+/*     C()    ON ENTRY with MODE = 1 or 2, C() CONTAINS A MATRIX WHICH */
+/*            WILL BE REGARDED AS A SET OF VECTORS TO WHICH THE */
+/*            HOUSEHOLDER TRANSFORMATION IS TO BE APPLIED. */
+/*            ON EXIT C() CONTAINS THE SET OF TRANSFORMED VECTORS. */
+/*     ICE    STORAGE INCREMENT BETWEEN ELEMENTS OF VECTORS IN C(). */
+/*     ICV    STORAGE INCREMENT BETWEEN VECTORS IN C(). */
+/*     NCV    NUMBER OF VECTORS IN C() TO BE TRANSFORMED. IF NCV .LE. 0 */
+/*            NO OPERATIONS WILL BE DONE ON C(). */
+/*     ------------------------------------------------------------------ */
+/* Subroutine */ int h12_(mode, lpivot, l1, m, u, iue, up, c__, ice, icv, ncv)
+integer *mode, *lpivot, *l1, *m;
+doublereal *u;
+integer *iue;
+doublereal *up, *c__;
+integer *ice, *icv, *ncv;
+{
+    /* System generated locals */
+    integer u_dim1, u_offset, i__1, i__2;
+    doublereal d__1, d__2;
+
+    /* Builtin functions */
+    /* The following line was commented out after the f2c translation */
+    /* double sqrt(); */
+
+    /* Local variables */
+    static integer incr;
+    static doublereal b;
+    static integer i__, j;
+    static doublereal clinv;
+    static integer i2, i3, i4;
+    static doublereal cl, sm;
+
+/*     ------------------------------------------------------------------ 
+*/
+/*     double precision U(IUE,M) */
+/*     ------------------------------------------------------------------ 
+*/
+    /* Parameter adjustments */
+    u_dim1 = *iue;
+    u_offset = u_dim1 + 1;
+    u -= u_offset;
+    --c__;
+
+    /* Function Body */
+    if (0 >= *lpivot || *lpivot >= *l1 || *l1 > *m) {
+	return 0;
+    }
+    cl = (d__1 = u[*lpivot * u_dim1 + 1], nnls_abs(d__1));
+    if (*mode == 2) {
+	goto L60;
+    }
+/*                            ****** CONSTRUCT THE TRANSFORMATION. ****** 
+*/
+    i__1 = *m;
+    for (j = *l1; j <= i__1; ++j) {
+/* L10: */
+/* Computing MAX */
+	d__2 = (d__1 = u[j * u_dim1 + 1], nnls_abs(d__1));
+	cl = nnls_max(d__2,cl);
+    }
+    if (cl <= 0.) {
+	goto L130;
+    } else {
+	goto L20;
+    }
+L20:
+    clinv = 1. / cl;
+/* Computing 2nd power */
+    d__1 = u[*lpivot * u_dim1 + 1] * clinv;
+    sm = d__1 * d__1;
+    i__1 = *m;
+    for (j = *l1; j <= i__1; ++j) {
+/* L30: */
+/* Computing 2nd power */
+	d__1 = u[j * u_dim1 + 1] * clinv;
+	sm += d__1 * d__1;
+    }
+    cl *= sqrt(sm);
+    if (u[*lpivot * u_dim1 + 1] <= 0.) {
+	goto L50;
+    } else {
+	goto L40;
+    }
+L40:
+    cl = -cl;
+L50:
+    *up = u[*lpivot * u_dim1 + 1] - cl;
+    u[*lpivot * u_dim1 + 1] = cl;
+    goto L70;
+/*            ****** APPLY THE TRANSFORMATION  I+U*(U**T)/B  TO C. ****** 
+*/
+
+L60:
+    if (cl <= 0.) {
+	goto L130;
+    } else {
+	goto L70;
+    }
+L70:
+    if (*ncv <= 0) {
+	return 0;
+    }
+    b = *up * u[*lpivot * u_dim1 + 1];
+/*                       B  MUST BE NONPOSITIVE HERE.  IF B = 0., RETURN. 
+*/
+
+    if (b >= 0.) {
+	goto L130;
+    } else {
+	goto L80;
+    }
+L80:
+    b = 1. / b;
+    i2 = 1 - *icv + *ice * (*lpivot - 1);
+    incr = *ice * (*l1 - *lpivot);
+    i__1 = *ncv;
+    for (j = 1; j <= i__1; ++j) {
+	i2 += *icv;
+	i3 = i2 + incr;
+	i4 = i3;
+	sm = c__[i2] * *up;
+	i__2 = *m;
+	for (i__ = *l1; i__ <= i__2; ++i__) {
+	    sm += c__[i3] * u[i__ * u_dim1 + 1];
+/* L90: */
+	    i3 += *ice;
+	}
+	if (sm != 0.) {
+	    goto L100;
+	} else {
+	    goto L120;
+	}
+L100:
+	sm *= b;
+	c__[i2] += sm * *up;
+	i__2 = *m;
+	for (i__ = *l1; i__ <= i__2; ++i__) {
+	    c__[i4] += sm * u[i__ * u_dim1 + 1];
+/* L110: */
+	    i4 += *ice;
+	}
+L120:
+	;
+    }
+L130:
+    return 0;
+} /* h12_ */
+
+doublereal diff_(x, y)
+doublereal *x, *y;
+{
+    /* System generated locals */
+    doublereal ret_val;
+
+
+/*  Function used in tests that depend on machine precision. */
+
+/*  The original version of this code was developed by */
+/*  Charles L. Lawson and Richard J. Hanson at Jet Propulsion Laboratory 
+*/
+/*  1973 JUN 7, and published in the book */
+/*  "SOLVING LEAST SQUARES PROBLEMS", Prentice-HalL, 1974. */
+/*  Revised FEB 1995 to accompany reprinting of the book by SIAM. */
+
+    ret_val = *x - *y;
+    return ret_val;
+} /* diff_ */
+
+
+/* The following subroutine was added after the f2c translation */
+int nnls_c(double* a, const int* mda, const int* m, const int* n, double* b, 
+	 double* x, double* rnorm, double* w, double* zz, int* index, 
+	 int* mode)
+{
+  return (nnls_(a, mda, m, n, b, x, rnorm, w, zz, index, mode));
+}
+

data/ext/nnls/nnls.c

@@ -0,0 +1,80 @@
+#include "ruby.h"
+
+int nnls_(a, mda, m, n, b, x, rnorm, w, zz, index, mode);
+
+VALUE nnls_module = Qnil;
+
+void Init_nnls();
+
+static VALUE nnls_method(VALUE self, VALUE A, VALUE b, VALUE Aw, VALUE Ah);
+
+/* The initialization method for this module */
+void Init_nnls() {
+  nnls_module = rb_define_module("NNLS");
+  rb_define_singleton_method(nnls_module, "_nnls", nnls_method, 4);
+}
+
+static VALUE nnls_method(VALUE self, VALUE A, VALUE B, VALUE Aw, VALUE Ah) {
+  long A_len = RARRAY_LEN(A);
+  long B_len = RARRAY_LEN(B);
+  long m = NUM2INT(Aw);
+  long n = NUM2INT(Ah);
+
+  double *A_copy = 0;
+  double *B_copy = 0;
+
+  double *X = 0;
+  double Rnorm = 0;
+  double *W = 0;
+  double *ZZ = 0;
+  int *index = 0;
+
+  int i = 0;
+  int mode = 0;
+  int mda = 0;
+
+  VALUE ret;
+  VALUE ret_x;
+
+  A_copy = malloc(sizeof(double) * m * n);
+  B_copy = malloc(sizeof(double) * m);
+  X = malloc(sizeof(double) * n);
+
+  W = malloc(sizeof(double) * n);
+  ZZ = malloc(sizeof(double) * m);
+  index = malloc(sizeof(int) * n);
+
+  mda = m;
+
+  for (i = 0; i < m * n; i++) {
+    A_copy[i] = NUM2DBL(rb_ary_entry(A, i));
+  }
+
+  for (i = 0; i < m; i++) {
+    B_copy[i] = NUM2DBL(rb_ary_entry(B, i));
+  }
+
+  nnls_(A_copy, &mda, &m, &n, B_copy, X, &Rnorm, W, ZZ, index, &mode);
+
+  /*
+    Now we have solution in array X,
+    let's copy it to ruby object
+   */
+  ret_x = rb_ary_new2(n);
+  for (i = 0; i < n; i++) {
+    rb_ary_push(ret_x, DBL2NUM(X[i]));
+  }
+
+  ret = rb_ary_new2(3);
+  rb_ary_push(ret, ret_x);
+  rb_ary_push(ret, DBL2NUM(Rnorm));
+  rb_ary_push(ret, INT2FIX(mode));
+
+  free(A_copy);
+  free(B_copy);
+  free(W);
+  free(ZZ);
+  free(X);
+
+  return ret;
+}

data/ext/nnls/test.rb

@@ -0,0 +1,8 @@
+require File.dirname(__FILE__) + "/nnls.so"
+
+A = [0.5, 0.3, 0.2,
+     0.2, 0.7, 0.8]
+
+B = [0.1, 0.1, 0.7]
+
+puts NNLS._nnls(A, B, 3, 2).inspect

data/lib/nnls.rb

@@ -0,0 +1,16 @@
+require 'nnls.so'
+
+module NNLS
+  def self.nnls(a, b, m, n)
+    x, rnorm, status = self._nnls(a, b, m, n)
+
+    case status
+    when 2
+      raise "The dimensions of the problem are bad (m = 0 or n = 0)"
+    when 3
+      raise "Iteration count exceeded (more than 3*n iterations)"
+    end
+
+    [x, rnorm]
+  end
+end

data/nnls.gemspec

@@ -0,0 +1,46 @@
+# Generated by jeweler
+# DO NOT EDIT THIS FILE DIRECTLY
+# Instead, edit Jeweler::Tasks in Rakefile, and run 'rake gemspec'
+# -*- encoding: utf-8 -*-
+
+Gem::Specification.new do |s|
+  s.name = "nnls"
+  s.version = "0.0.1"
+
+  s.required_rubygems_version = Gem::Requirement.new(">= 0") if s.respond_to? :required_rubygems_version=
+  s.authors = ["Mikhail Lapshin"]
+  s.date = "2011-12-08"
+  s.description = "Ruby bindings for C. Lawson and R. Hanson 'Non-negative Less Square' algorithm implementation."
+  s.email = "sotakone@sotakone.com"
+  s.extensions = ["ext/nnls/extconf.rb"]
+  s.extra_rdoc_files = [
+    "README.md"
+  ]
+  s.files = [
+    "README.md",
+    "Rakefile",
+    "VERSION",
+    "ext/nnls/extconf.rb",
+    "ext/nnls/impl.c",
+    "ext/nnls/nnls.c",
+    "ext/nnls/test.rb",
+    "lib/nnls.rb",
+    "nnls.gemspec",
+    "test/nnls_test.rb",
+    "test/test_helper.rb"
+  ]
+  s.homepage = "http://github.com/sotakone/nnls/"
+  s.require_paths = ["lib"]
+  s.rubygems_version = "1.8.11"
+  s.summary = "Non-negative Less Square Algorithm"
+
+  if s.respond_to? :specification_version then
+    s.specification_version = 3
+
+    if Gem::Version.new(Gem::VERSION) >= Gem::Version.new('1.2.0') then
+    else
+    end
+  else
+  end
+end
+

data/test/nnls_test.rb

@@ -0,0 +1,20 @@
+require File.dirname(__FILE__) + "/test_helper"
+
+class NnlsTest < Test::Unit::TestCase
+  def test_nnls
+    a = [0.5, 0.3, 0.2,
+         0.2, 0.7, 0.8]
+
+    b = [0.1, 0.1, 0.7]
+
+    result = nil
+    assert_nothing_raised do
+      result = NNLS.nnls(a, b, 2, 3)
+    end
+
+    assert_equal Array, result[0].class
+    assert_equal 3, result[0].size
+
+    assert_equal Float, result[1].class
+  end
+end

data/test/test_helper.rb

@@ -0,0 +1,5 @@
+$LOAD_PATH << File.dirname(__FILE__) + "/../lib"
+$LOAD_PATH << File.dirname(__FILE__) + "/../ext"
+
+require 'test/unit'
+require "nnls"

metadata

@@ -0,0 +1,58 @@
+--- !ruby/object:Gem::Specification
+name: nnls
+version: !ruby/object:Gem::Version
+  version: 0.0.1
+  prerelease: 
+platform: ruby
+authors:
+- Mikhail Lapshin
+autorequire: 
+bindir: bin
+cert_chain: []
+date: 2011-12-08 00:00:00.000000000 Z
+dependencies: []
+description: Ruby bindings for C. Lawson and R. Hanson 'Non-negative Less Square'
+  algorithm implementation.
+email: sotakone@sotakone.com
+executables: []
+extensions:
+- ext/nnls/extconf.rb
+extra_rdoc_files:
+- README.md
+files:
+- README.md
+- Rakefile
+- VERSION
+- ext/nnls/extconf.rb
+- ext/nnls/impl.c
+- ext/nnls/nnls.c
+- ext/nnls/test.rb
+- lib/nnls.rb
+- nnls.gemspec
+- test/nnls_test.rb
+- test/test_helper.rb
+homepage: http://github.com/sotakone/nnls/
+licenses: []
+post_install_message: 
+rdoc_options: []
+require_paths:
+- lib
+required_ruby_version: !ruby/object:Gem::Requirement
+  none: false
+  requirements:
+  - - ! '>='
+    - !ruby/object:Gem::Version
+      version: '0'
+required_rubygems_version: !ruby/object:Gem::Requirement
+  none: false
+  requirements:
+  - - ! '>='
+    - !ruby/object:Gem::Version
+      version: '0'
+requirements: []
+rubyforge_project: 
+rubygems_version: 1.8.11
+signing_key: 
+specification_version: 3
+summary: Non-negative Less Square Algorithm
+test_files: []