numo-narray 0.9.0.1

data/ext/numo/narray/gen/tmpl/head.c

@@ -0,0 +1,25 @@
+/*
+  <%=type_name%>.c
+  Numerical Array Extension for Ruby
+    (C) Copyright 1999-2011,2013 by Masahiro TANAKA
+
+  This program is free software.
+  You can distribute/modify this program
+  under the same terms as Ruby itself.
+  NO WARRANTY.
+*/
+
+#include <ruby.h>
+#include <math.h>
+#include "narray.h"
+#include "SFMT.h"
+#include "template.h"
+#include "<%=type_name%>.h"
+
+//#define cT  <%=type_var%>
+VALUE cT;
+//#define cRT <%=real_type_var%>
+
+#ifdef mTM
+VALUE mTM;
+#endif

data/ext/numo/narray/gen/tmpl/inspect.c

@@ -0,0 +1,16 @@
+static VALUE
+<%=c_iter%>(char *ptr, size_t pos, VALUE fmt)
+{
+    return format_<%=tp%>(fmt, (dtype*)(ptr+pos));
+}
+
+/*
+  Returns a string containing a human-readable representation of NArray.
+  @overload inspect
+  @return [String]
+*/
+VALUE
+<%=c_func%>(VALUE ary)
+{
+    return na_ndloop_inspect(ary, <%=c_iter%>, Qnil);
+}

data/ext/numo/narray/gen/tmpl/map_with_index.c

@@ -0,0 +1,94 @@
+static inline dtype
+yield_map_with_index(dtype x, size_t *c, VALUE *a, int nd, int md)
+{
+    int j;
+    VALUE y;
+
+    a[0] = m_data_to_num(x);
+    for (j=0; j<=nd; j++) {
+        a[j+1] = SIZE2NUM(c[j]);
+    }
+    y = rb_yield(rb_ary_new4(md,a));
+    return m_num_to_data(y);
+}
+
+void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    size_t  i;
+    char   *p1, *p2;
+    ssize_t s1, s2;
+    size_t *idx1, *idx2;
+    dtype x;
+    VALUE *a;
+    size_t *c;
+    int nd, md;
+
+    c = (size_t*)(lp->opt_ptr);
+    nd = lp->ndim - 1;
+    md = lp->ndim + 1;
+    a = ALLOCA_N(VALUE,md);
+
+    INIT_COUNTER(lp, i);
+    INIT_PTR_IDX(lp, 0, p1, s1, idx1);
+    INIT_PTR_IDX(lp, 1, p2, s2, idx2);
+
+    c[nd] = 0;
+    if (idx1) {
+        if (idx2) {
+            for (; i--;) {
+                GET_DATA_INDEX(p1,idx1,dtype,x);
+                x = yield_map_with_index(x,c,a,nd,md);
+                SET_DATA_INDEX(p2,idx2,dtype,x);
+                c[nd]++;
+            }
+        } else {
+            for (; i--;) {
+                GET_DATA_INDEX(p1,idx1,dtype,x);
+                x = yield_map_with_index(x,c,a,nd,md);
+                SET_DATA_STRIDE(p2,s2,dtype,x);
+                c[nd]++;
+            }
+        }
+    } else {
+        if (idx2) {
+            for (; i--;) {
+                GET_DATA_STRIDE(p1,s1,dtype,x);
+                x = yield_map_with_index(x,c,a,nd,md);
+                SET_DATA_INDEX(p2,idx2,dtype,x);
+                c[nd]++;
+            }
+        } else {
+            for (; i--;) {
+                GET_DATA_STRIDE(p1,s1,dtype,x);
+                x = yield_map_with_index(x,c,a,nd,md);
+                SET_DATA_STRIDE(p2,s2,dtype,x);
+                c[nd]++;
+            }
+        }
+    }
+}
+
+/*
+  Invokes the given block once for each element of self,
+  passing that element and indices along each axis as parameters.
+  Creates a new NArray containing the values returned by the block.
+  Inplace option is allowed, i.e., `nary.inplace.map` overwrites `nary`.
+
+  @overload <%=method%>
+
+  For a block {|x,i,j,...| ... }
+  @yield [x,i,j,...]  x is an element, i,j,... are multidimensional indices.
+
+  @return [Numo::NArray] mapped array
+
+*/
+static VALUE
+<%=c_func%>(VALUE self)
+{
+    ndfunc_arg_in_t ain[1] = {{Qnil,0}};
+    ndfunc_arg_out_t aout[1] = {{cT,0}};
+    ndfunc_t ndf = {<%=c_iter%>, FULL_LOOP, 1,1, ain,aout};
+
+    return na_ndloop_with_index(&ndf, 1, self);
+}

data/ext/numo/narray/gen/tmpl/median.c

@@ -0,0 +1,44 @@
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    size_t n;
+    char *p1, *p2;
+    dtype *buf;
+
+    INIT_COUNTER(lp, n);
+    p1 = (lp->args[0]).ptr + (lp->args[0].iter[0]).pos;
+    p2 = (lp->args[1]).ptr + (lp->args[1].iter[0]).pos;
+    buf = (dtype*)p1;
+
+    <%=tp%>_qsort(buf, n, sizeof(dtype));
+
+    <% if is_float %>
+    for (; n; n--) {
+        if (!isnan(buf[n-1])) break;
+    }
+    <% end %>
+
+    if (n==0) {
+        *(dtype*)p2 = buf[0];
+    }
+    else if (n%2==0) {
+        *(dtype*)p2 = (buf[n/2-1]+buf[n/2])/2;
+    }
+    else {
+        *(dtype*)p2 = buf[(n-1)/2];
+    }
+}
+
+static VALUE
+<%=c_func%>(int argc, VALUE *argv, VALUE self)
+{
+    VALUE reduce;
+    ndfunc_arg_in_t ain[2] = {{cT,0},{sym_reduce,0}};
+    ndfunc_arg_out_t aout[1] = {{INT2FIX(0),0}};
+    ndfunc_t ndf = {<%=c_iter%>, STRIDE_LOOP_NIP|NDF_FLAT_REDUCE, 2,1, ain,aout};
+
+    self = na_copy(self);
+    reduce = na_reduce_dimension(argc, argv, 1, &self); // v[0] = self
+
+    return na_ndloop(&ndf, 2, self, reduce);
+}

data/ext/numo/narray/gen/tmpl/minmax.c

@@ -0,0 +1,47 @@
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    size_t   i;
+    char    *p1;
+    ssize_t  s1;
+    dtype    x,xmin,xmax;
+
+    INIT_COUNTER(lp, i);
+    INIT_PTR(lp, 0, p1, s1);
+
+    xmin = xmax = *(dtype*)p1;
+    p1 += s1;
+    i--;
+    for (; i--;) {
+        x = *(dtype*)p1;
+        if (!m_isnan(x)) {
+            if (m_isnan(xmax) || m_gt(x,xmax)) {
+                xmax = x;
+            }
+            if (m_isnan(xmin) || m_lt(x,xmin)) {
+                xmin = x;
+            }
+        }
+        p1 += s1;
+    }
+    *(dtype*)(lp->args[1].ptr + lp->args[1].iter[0].pos) = xmin;
+    *(dtype*)(lp->args[2].ptr + lp->args[2].iter[0].pos) = xmax;
+}
+
+/*
+  <%=method.capitalize%> of self.
+  @overload <%=method%>(*args)
+  @param [Array of Numeric,Range] args  Affected dimensions.
+  @return [Numo::<%=class_name%>,Numo::<%=class_name%>] min and max of self.
+*/
+static VALUE
+<%=c_func%>(int argc, VALUE *argv, VALUE self)
+{
+    VALUE reduce;
+    ndfunc_arg_in_t ain[2] = {{cT,0},{sym_reduce,0}};
+    ndfunc_arg_out_t aout[2] = {{cT,0},{cT,0}};
+    ndfunc_t ndf = {<%=c_iter%>, STRIDE_LOOP_NIP|NDF_FLAT_REDUCE|NDF_EXTRACT, 2,2, ain,aout};
+
+    reduce = na_reduce_dimension(argc, argv, 1, &self);
+    return na_ndloop(&ndf, 2, self, reduce);
+}

data/ext/numo/narray/gen/tmpl/poly.c

@@ -0,0 +1,49 @@
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    size_t  i;
+    dtype  x, y, a;
+
+    x = *(dtype*)(lp->args[0].ptr + lp->args[0].iter[0].pos);
+    i = lp->narg - 2;
+    y = *(dtype*)(lp->args[i].ptr + lp->args[i].iter[0].pos);
+    for (; --i;) {
+        y = m_mul(x,y);
+        a = *(dtype*)(lp->args[i].ptr + lp->args[i].iter[0].pos);
+        y = m_add(y,a);
+    }
+    i = lp->narg - 1;
+    *(dtype*)(lp->args[i].ptr + lp->args[i].iter[0].pos) = y;
+}
+
+/*
+  Polynomial.: a0 + a1*x + a2*x**2 + a3*x**3 + ... + an*x**n
+  @overload <%=method%> a0, a1, ...
+  @param [Numo::NArray,Numeric] a0
+  @param [Numo::NArray,Numeric] a1 , ...
+  @return [Numo::<%=class_name%>]
+*/
+static VALUE
+<%=c_func%>(VALUE self, VALUE args)
+{
+    int argc, i;
+    VALUE *argv;
+    volatile VALUE v, a;
+    ndfunc_arg_out_t aout[1] = {{cT,0}};
+    ndfunc_t ndf = { <%=c_iter%>, NO_LOOP, 0, 1, 0, aout };
+
+    argc = RARRAY_LEN(args);
+    ndf.nin = argc+1;
+    ndf.ain = ALLOCA_N(ndfunc_arg_in_t,argc+1);
+    for (i=0; i<argc+1; i++) {
+        ndf.ain[i].type = cT;
+    }
+    argv = ALLOCA_N(VALUE,argc+1);
+    argv[0] = self;
+    for (i=0; i<argc; i++) {
+        argv[i+1] = RARRAY_PTR(args)[i];
+    }
+    a = rb_ary_new4(argc+1, argv);
+    v = na_ndloop2(&ndf, a);
+    return numo_<%=tp%>_extract(v);
+}

data/ext/numo/narray/gen/tmpl/pow.c

@@ -0,0 +1,74 @@
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    size_t  i;
+    char    *p1, *p2, *p3;
+    ssize_t s1, s2, s3;
+    dtype    x, y;
+    INIT_COUNTER(lp, i);
+    INIT_PTR(lp, 0, p1, s1);
+    INIT_PTR(lp, 1, p2, s2);
+    INIT_PTR(lp, 2, p3, s3);
+    for (; i--;) {
+        GET_DATA_STRIDE(p1,s1,dtype,x);
+        GET_DATA_STRIDE(p2,s2,dtype,y);
+        x = m_pow(x,y);
+        SET_DATA_STRIDE(p3,s3,dtype,x);
+    }
+}
+
+static void
+<%=c_iter%>_int32(na_loop_t *const lp)
+{
+    size_t  i;
+    char   *p1, *p2, *p3;
+    ssize_t s1, s2, s3;
+    dtype   x;
+    int32_t y;
+    INIT_COUNTER(lp, i);
+    INIT_PTR(lp, 0, p1, s1);
+    INIT_PTR(lp, 1, p2, s2);
+    INIT_PTR(lp, 2, p3, s3);
+    for (; i--;) {
+        GET_DATA_STRIDE(p1,s1,dtype,x);
+        GET_DATA_STRIDE(p2,s2,int32_t,y);
+        x = m_pow_int(x,y);
+        SET_DATA_STRIDE(p3,s3,dtype,x);
+    }
+}
+
+static VALUE
+<%=c_func%>_self(VALUE self, VALUE other)
+{
+    ndfunc_arg_in_t ain[2] = {{cT,0},{cT,0}};
+    ndfunc_arg_in_t ain_i[2] = {{cT,0},{numo_cInt32,0}};
+    ndfunc_arg_out_t aout[1] = {{cT,0}};
+    ndfunc_t ndf = { <%=c_iter%>, STRIDE_LOOP, 2, 1, ain, aout };
+    ndfunc_t ndf_i = { <%=c_iter%>_int32, STRIDE_LOOP, 2, 1, ain_i, aout };
+
+    // fixme : use na.integer?
+    if (FIXNUM_P(other) || rb_obj_is_kind_of(other,numo_cInt32)) {
+        return na_ndloop(&ndf_i, 2, self, other);
+    } else {
+        return na_ndloop(&ndf, 2, self, other);
+    }
+}
+
+/*
+  Binary power.
+  @overload <%=op_map%> other
+  @param [Numo::NArray,Numeric] other
+  @return [Numo::NArray] self to the other-th power.
+*/
+static VALUE
+<%=c_func%>(VALUE self, VALUE other)
+{
+    VALUE klass, v;
+    klass = na_upcast(CLASS_OF(self),CLASS_OF(other));
+    if (klass==cT) {
+        return <%=c_func%>_self(self,other);
+    } else {
+        v = rb_funcall(klass, id_cast, 1, self);
+        return rb_funcall(v, id_pow, 1, other);
+    }
+}

data/ext/numo/narray/gen/tmpl/powint.c

@@ -0,0 +1,17 @@
+static dtype pow_<%=tp%>(dtype x, int p)
+{
+    dtype r = m_one;
+    switch(p) {
+    case 2: return m_square(x);
+    case 3: return m_mul(m_square(x),x);
+    case 1: return x;
+    case 0: return m_one;
+    }
+    if (p<0)  return m_zero;
+    while (p) {
+        if ((p%2) == 1) r = m_mul(r,x);
+        x = m_square(x);
+        p /= 2;
+    }
+    return r;
+}

data/ext/numo/narray/gen/tmpl/qsort.c

@@ -0,0 +1,149 @@
+/*
+  qsort.c
+  Numerical Array Extension for Ruby
+    (C) Copyright 2007-2011 by Masahiro TANAKA
+
+  This program is free software.
+  You can distribute/modify this program
+  under the same terms as Ruby itself.
+  NO WARRANTY.
+*/
+
+/*
+ *      qsort.c: standard quicksort algorithm
+ *
+ *      Modifications from vanilla NetBSD source:
+ *        Add do ... while() macro fix
+ *        Remove __inline, _DIAGASSERTs, __P
+ *        Remove ill-considered "swap_cnt" switch to insertion sort,
+ *        in favor of a simple check for presorted input.
+ *
+ *      CAUTION: if you change this file, see also qsort_arg.c
+ *
+ *      $PostgreSQL: pgsql/src/port/qsort.c,v 1.12 2006/10/19 20:56:22 tgl Exp $
+ */
+
+/*      $NetBSD: qsort.c,v 1.13 2003/08/07 16:43:42 agc Exp $   */
+
+/*-
+ * Copyright (c) 1992, 1993
+ *      The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *        notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *        notice, this list of conditions and the following disclaimer in the
+ *        documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of the University nor the names of its contributors
+ *        may be used to endorse or promote products derived from this software
+ *        without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.      IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#ifndef QSORT_INCL
+#define QSORT_INCL
+#define Min(x, y)               ((x) < (y) ? (x) : (y))
+
+#define swap(type,a,b) \
+    do {type tmp=*(type*)(a); *(type*)(a)=*(type*)(b); *(type*)(b)=tmp;} while(0)
+
+#define vecswap(type, a, b, n) if ((n)>0) swap(type,(a),(b))
+
+#define MED3(a,b,c)                                     \
+    (cmpgt(b,a) ?                                       \
+     (cmpgt(c,b) ? b : (cmpgt(c,a) ? c : a))            \
+     : (cmpgt(b,c) ? b : (cmpgt(c,a) ? a : c)))
+#endif
+
+#undef qsort_dtype
+#define qsort_dtype <%=dtype%>
+#undef qsort_cast
+#define qsort_cast <%=dcast%>
+
+void
+<%=tp%>_qsort(void *a, size_t n, ssize_t es)
+{
+    char *pa, *pb, *pc, *pd, *pl, *pm, *pn;
+    int  d, r, presorted;
+
+ loop:
+    if (n < 7) {
+        for (pm = (char *) a + es; pm < (char *) a + n * es; pm += es)
+            for (pl = pm; pl > (char *) a && cmpgt(pl - es, pl);
+                 pl -= es)
+                swap(qsort_dtype, pl, pl - es);
+        return;
+    }
+    presorted = 1;
+    for (pm = (char *) a + es; pm < (char *) a + n * es; pm += es) {
+        if (cmpgt(pm - es, pm)) {
+            presorted = 0;
+            break;
+        }
+    }
+    if (presorted)
+        return;
+    pm = (char *) a + (n / 2) * es;
+    if (n > 7) {
+        pl = (char *) a;
+        pn = (char *) a + (n - 1) * es;
+        if (n > 40) {
+            d = (n / 8) * es;
+            pl = MED3(pl, pl + d, pl + 2 * d);
+            pm = MED3(pm - d, pm, pm + d);
+            pn = MED3(pn - 2 * d, pn - d, pn);
+        }
+        pm = MED3(pl, pm, pn);
+    }
+    swap(qsort_dtype, a, pm);
+    pa = pb = (char *) a + es;
+    pc = pd = (char *) a + (n - 1) * es;
+    for (;;) {
+        while (pb <= pc && (r = cmp(pb, a)) <= 0) {
+            if (r == 0) {
+                swap(qsort_dtype, pa, pb);
+                pa += es;
+            }
+            pb += es;
+        }
+        while (pb <= pc && (r = cmp(pc, a)) >= 0) {
+            if (r == 0) {
+                swap(qsort_dtype, pc, pd);
+                pd -= es;
+            }
+            pc -= es;
+        }
+        if (pb > pc)
+            break;
+        swap(qsort_dtype, pb, pc);
+        pb += es;
+        pc -= es;
+    }
+    pn = (char *) a + n * es;
+    r = Min(pa - (char *) a, pb - pa);
+    vecswap(qsort_dtype, a, pb - r, r);
+    r = Min(pd - pc, pn - pd - es);
+    vecswap(qsort_dtype, pb, pn - r, r);
+    if ((r = pb - pa) > es)
+        <%=tp%>_qsort(a, r / es, es);
+    if ((r = pd - pc) > es) {
+        a = pn - r;
+        n = r / es;
+        goto loop;
+    }
+}
+