numo-narray 0.9.0.1-x64-mingw32

data/ext/numo/narray/numo/ndloop.h

@@ -0,0 +1,99 @@
+/*
+  ndloop.h
+  Numerical Array Extension for Ruby
+    (C) Copyright 1999-2016 by Masahiro TANAKA
+
+  This program is free software.
+  You can distribute/modify this program
+  under the same terms as Ruby itself.
+  NO WARRANTY.
+*/
+#ifndef NDLOOP_H
+#define NDLOOP_H
+
+typedef struct NA_LOOP_ITER {
+    ssize_t    pos; // - required for each dimension.
+    ssize_t    step;
+    size_t    *idx;
+} na_loop_iter_t;
+
+typedef struct NA_LOOP_ARGS {
+    VALUE    value;
+    ssize_t  elmsz;
+    char    *ptr;
+    //char    *buf_ptr;  //
+    int      ndim;       // required for each argument.
+    // ssize_t pos; - not required here.
+    size_t  *shape;
+    na_loop_iter_t *iter;  // moved from na_loop_t
+} na_loop_args_t;
+
+// pass this structure to user iterator
+typedef struct NA_LOOP {
+    int  narg;
+    int  ndim;             // n of user dimention  - required for each iterator.
+    size_t *n;             // n of elements for each dim (=shape)
+    na_loop_args_t *args;  // for each arg
+    VALUE  option;
+    void  *opt_ptr;
+    VALUE  err_type;
+} na_loop_t;
+
+
+// ------------------ ndfunc -------------------------------------------
+
+#define NDF_HAS_LOOP            (1<<0) // x[i]
+#define NDF_STRIDE_LOOP         (1<<1) // *(x+stride*i)
+#define NDF_INDEX_LOOP          (1<<2) // *(x+idx[i])
+#define NDF_KEEP_DIM            (1<<3)
+#define NDF_INPLACE             (1<<4)
+#define NDF_ACCEPT_BYTESWAP     (1<<5)
+
+#define NDF_FLAT_REDUCE         (1<<6)
+#define NDF_EXTRACT             (1<<7)
+#define NDF_CUM                 (1<<8)
+
+#define FULL_LOOP       (NDF_HAS_LOOP|NDF_STRIDE_LOOP|NDF_INDEX_LOOP|NDF_INPLACE)
+#define FULL_LOOP_NIP   (NDF_HAS_LOOP|NDF_STRIDE_LOOP|NDF_INDEX_LOOP)
+#define STRIDE_LOOP     (NDF_HAS_LOOP|NDF_STRIDE_LOOP|NDF_INPLACE)
+#define STRIDE_LOOP_NIP (NDF_HAS_LOOP|NDF_STRIDE_LOOP)
+#define NO_LOOP         0
+
+#define OVERWRITE Qtrue // used for CASTABLE(t)
+
+#define NDF_TEST(nf,fl)  ((nf)->flag & (fl))
+#define NDF_SET(nf,fl)  {(nf)->flag |= (fl);}
+
+#define NDF_ARG_READ_ONLY   1
+#define NDF_ARG_WRITE_ONLY  2
+#define NDF_ARG_READ_WRITE  3
+
+// type of user function
+typedef void (*na_iter_func_t) _((na_loop_t *const));
+typedef VALUE (*na_text_func_t) _((char *ptr, size_t pos, VALUE opt));
+//typedef void (*) void (*loop_func)(ndfunc_t*, na_md_loop_t*))
+
+
+typedef struct NDF_ARG_IN {
+    VALUE   type;    // argument types
+    int     dim;     // # of dimension of argument handled by user function
+                     // if dim==-1, reduce dimension
+} ndfunc_arg_in_t;
+
+typedef struct NDF_ARG_OUT {
+    VALUE   type;    // argument types
+    int     dim;     // # of dimension of argument handled by user function
+    size_t *shape;
+} ndfunc_arg_out_t;
+
+// spec of user function
+typedef struct NDFUNCTION {
+    na_iter_func_t func;    // user function
+    unsigned int flag;      // what kind of loop user function supports
+    int nin;                // # of arguments
+    int nout;               // # of results
+    ndfunc_arg_in_t *ain;   // spec of input arguments
+    ndfunc_arg_out_t *aout; // spec of output result
+} ndfunc_t;
+
+#endif /* NDLOOP_H */

data/ext/numo/narray/numo/template.h

@@ -0,0 +1,140 @@
+/*
+  narray.h
+  Numerical Array Extension for Ruby
+    (C) Copyright 1999-2003 by Masahiro TANAKA
+
+  This program is free software.
+  You can distribute/modify this program
+  under the same terms as Ruby itself.
+  NO WARRANTY.
+*/
+#ifndef TEMPLATE_H
+#define TEMPLATE_H
+
+#define INIT_COUNTER( lp, c )                   \
+    {   c = (lp)->n[0]; }
+
+#define NDL_CNT(lp) ((lp)->n[0])
+#define NDL_PTR(lp,i) (((lp)->args[i]).ptr + ((lp)->args[i].iter[0]).pos)
+#define NDL_STP(lp,i) (((lp)->args[i].iter[0]).step)
+#define NDL_IDX(lp,i) (((lp)->args[i].iter[0]).idx)
+#define NDL_ESZ(lp,i) (((lp)->args[i]).elmsz)
+
+#define INIT_PTR( lp, i, pt, st )                               \
+    {                                                           \
+        pt = ((lp)->args[i]).ptr + ((lp)->args[i].iter[0]).pos;         \
+        st = ((lp)->args[i].iter[0]).step;                              \
+    }
+
+#define INIT_PTR_IDX( lp, i, pt, st, id )                       \
+    {                                                           \
+        pt = ((lp)->args[i]).ptr + ((lp)->args[i].iter[0]).pos;         \
+        st = ((lp)->args[i].iter[0]).step;                              \
+        id = ((lp)->args[i].iter[0]).idx;                               \
+    }
+
+#define INIT_ELMSIZE( lp, i, es )                               \
+    {                                                           \
+        es = ((lp)->args[i]).elmsz;                             \
+    }
+
+#define INIT_PTR_BIT( lp, i, ad, ps, st )               \
+    {                                                   \
+        ps = ((lp)->args[i].iter[0]).pos;                       \
+        ad = (BIT_DIGIT*)(((lp)->args[i]).ptr) + ps/NB; \
+        ps %= NB;                                       \
+        st = ((lp)->args[i].iter[0]).step;                      \
+    }
+
+#define INIT_PTR_BIT_IDX( lp, i, ad, ps, st, id )       \
+    {                                                   \
+        ps = ((lp)->args[i].iter[0]).pos;                       \
+        ad = (BIT_DIGIT*)(((lp)->args[i]).ptr) + ps/NB; \
+        ps %= NB;                                       \
+        st = ((lp)->args[i].iter[0]).step;                      \
+        id = ((lp)->args[i].iter[0]).idx;                       \
+    }
+
+#define GET_DATA( ptr, type, val )                 \
+    {                                              \
+        val = *(type*)(ptr);                       \
+    }
+
+#define SET_DATA( ptr, type, val )                 \
+    {                                              \
+        *(type*)(ptr) = val;                       \
+    }
+
+#define GET_DATA_STRIDE( ptr, step, type, val )    \
+    {                                              \
+        val = *(type*)(ptr);                       \
+        ptr += step;                               \
+    }
+
+#define GET_DATA_INDEX( ptr, idx, type, val )     \
+    {                                           \
+        val = *(type*)(ptr + *idx);             \
+        idx++;                                  \
+    }
+
+#define SET_DATA_STRIDE( ptr, step, type, val ) \
+    {                                           \
+        *(type*)(ptr) = val;                    \
+        ptr += step;                            \
+    }
+
+#define SET_DATA_INDEX( ptr, idx, type, val )   \
+    {                                           \
+        *(type*)(ptr + *idx) = val;             \
+        idx++;                                  \
+    }
+
+#define LOAD_BIT( adr, pos, val )                       \
+    {                                                   \
+        size_t dig = (pos) / NB;                        \
+        int    bit = (pos) % NB;                        \
+        val = (((BIT_DIGIT*)(adr))[dig]>>(bit)) & 1u;   \
+    }
+
+#define LOAD_BIT_STEP( adr, pos, step, idx, val )       \
+    {                                                   \
+        size_t dig; int bit;                            \
+        if (idx) {                                      \
+            dig = ((pos) + *(idx)) / NB;                \
+            bit = ((pos) + *(idx)) % NB;                \
+            idx++;                                      \
+        } else {                                        \
+            dig = (pos) / NB;                           \
+            bit = (pos) % NB;                           \
+            pos += step;                                \
+        }                                               \
+        val = (((BIT_DIGIT*)(adr))[dig]>>bit) & 1u;     \
+    }
+
+#define STORE_BIT(adr,pos,val)                  \
+    {                                           \
+        size_t dig = (pos) / NB;                \
+        int    bit = (pos) % NB;                \
+        ((BIT_DIGIT*)(adr))[dig] =              \
+            (((BIT_DIGIT*)(adr))[dig] & ~(1u<<(bit))) | ((val)<<(bit)); \
+    }
+// val -> val&1 ??
+
+#define STORE_BIT_STEP( adr, pos, step, idx, val )\
+    {                                           \
+        size_t dig; int bit;                    \
+        if (idx) {                              \
+            dig = ((pos) + *(idx)) / NB;        \
+            bit = ((pos) + *(idx)) % NB;        \
+            idx++;                              \
+        } else {                                \
+            dig = (pos) / NB;                   \
+            bit = (pos) % NB;                   \
+            pos += step;                        \
+        }                                       \
+        ((BIT_DIGIT*)(adr))[dig] =              \
+            (((BIT_DIGIT*)(adr))[dig] & ~(1u<<(bit))) | ((val)<<(bit)); \
+    }
+// val -> val&1 ??
+
+#endif /* ifndef NARRAY_H */

data/ext/numo/narray/numo/types/bit.h

@@ -0,0 +1,19 @@
+typedef int dtype;
+
+#define m_load_data(ptr,pos) load_data(ptr,pos)
+
+#define m_sprintf(s,x)   sprintf(s,"%1d",(int)(x))
+
+#define m_bit_not(x)   (~(x))
+
+#define m_bit_and(x,y) ((x)&(y))
+#define m_bit_or(x,y)  ((x)|(y))
+#define m_bit_xor(x,y) ((x)^(y))
+#define m_eq(x,y)      (~((x)^(y)))
+
+#define m_count_true(x)  (x!=0)
+#define m_count_false(x) (x==0)
+
+static inline dtype load_data(void *ptr, size_t pos) {
+    return (((BIT_DIGIT*)(ptr))[(pos)/NB]>>((pos)%NB)) & 1u;
+}

data/ext/numo/narray/numo/types/complex.h

@@ -0,0 +1,410 @@
+/*
+  complex.h
+  Numerical Array Extension for Ruby
+    (C) Copyright 1999-2007 by Masahiro TANAKA
+
+  This program is free software.
+  You can distribute/modify this program
+  under the same terms as Ruby itself.
+  NO WARRANTY.
+*/
+
+
+static inline dtype c_new(rtype r, rtype i) {
+    dtype z;
+    REAL(z) = r;
+    IMAG(z) = i;
+    return z;
+}
+
+static inline dtype c_set_real(dtype x, rtype r) {
+    REAL(x)=r;
+    return x;
+}
+
+static inline dtype c_set_imag(dtype x, rtype i) {
+    IMAG(x)=i;
+    return x;
+}
+
+static inline VALUE COMP2NUM(dtype x) {
+    VALUE v;
+    v = rb_funcall(rb_intern("Kernel"), rb_intern("Complex"), 2,
+                   rb_float_new(REAL(x)), rb_float_new(IMAG(x)));
+    return v;
+}
+
+static inline dtype NUM2COMP(VALUE v) {
+    dtype z;
+    REAL(z) = NUM2DBL(rb_funcall(v,id_real,0));
+    IMAG(z) = NUM2DBL(rb_funcall(v,id_imag,0));
+    return z;
+}
+
+#define c_is_zero(x) (REAL(x)==0 && IMAG(x)==0)
+#define c_eq(x,y) (REAL(x)==REAL(y) && IMAG(x)==IMAG(y))
+#define c_ne(x,y) (REAL(x)!=REAL(y) || IMAG(x)!=IMAG(y))
+#define c_isnan(x) (isnan(REAL(x))||isnan(IMAG(x)))
+#define c_isinf(x) (isinf(REAL(x))||isinf(IMAG(x)))
+#define c_isfinite(x) (isfinite(REAL(x))&&isfinite(IMAG(x)))
+
+static inline dtype c_zero() {
+    dtype z;
+    REAL(z) = 0;
+    IMAG(z) = 0;
+    return z;
+}
+
+static inline dtype c_one() {
+    dtype z;
+    REAL(z) = 1;
+    IMAG(z) = 0;
+    return z;
+}
+
+static inline dtype c_minus(dtype x) {
+    dtype z;
+    REAL(z) = -REAL(x);
+    IMAG(z) = -IMAG(x);
+    return z;
+}
+
+static inline dtype c_im(dtype x) {
+    dtype z;
+    REAL(z) = -IMAG(x);
+    IMAG(z) = REAL(x);
+    return z;
+}
+
+static inline dtype c_add(dtype x, dtype y) {
+    dtype z;
+    REAL(z) = REAL(x)+REAL(y);
+    IMAG(z) = IMAG(x)+IMAG(y);
+    return z;
+}
+
+static inline dtype c_sub(dtype x, dtype y) {
+    dtype z;
+    REAL(z) = REAL(x)-REAL(y);
+    IMAG(z) = IMAG(x)-IMAG(y);
+    return z;
+}
+
+
+static inline dtype c_mul(dtype x, dtype y) {
+    dtype z;
+    REAL(z) = REAL(x)*REAL(y)-IMAG(x)*IMAG(y);
+    IMAG(z) = REAL(x)*IMAG(y)+IMAG(x)*REAL(y);
+    return z;
+}
+
+static inline dtype c_mul_r(dtype x, rtype y) {
+    dtype z;
+    REAL(z) = REAL(x)*y;
+    IMAG(z) = IMAG(x)*y;
+    return z;
+}
+
+static inline dtype c_div(dtype x, dtype y) {
+    dtype z;
+    rtype s,yr,yi;
+    s  = r_hypot(REAL(y),IMAG(y));
+    yr = REAL(y)/s;
+    yi = IMAG(y)/s;
+    REAL(z) = (REAL(x)*yr+IMAG(x)*yi)/s;
+    IMAG(z) = (IMAG(x)*yr-REAL(x)*yi)/s;
+    return z;
+}
+
+static inline dtype c_div_r(dtype x, rtype y) {
+    dtype z;
+    REAL(z) = REAL(x)/y;
+    IMAG(z) = IMAG(x)/y;
+    return z;
+}
+
+static inline dtype c_inverse(dtype x) {
+    dtype z;
+    if ( r_abs(REAL(x)) > r_abs(IMAG(x)) ) {
+        IMAG(z) = IMAG(x)/REAL(x);
+        REAL(z) = (1+IMAG(z)*IMAG(z))*REAL(x);
+        IMAG(z) /= -REAL(z);
+        REAL(z) = 1/REAL(z);
+    } else {
+        REAL(z) = REAL(x)/IMAG(x);
+        IMAG(z) = (1+REAL(z)*REAL(z))*IMAG(x);
+        REAL(z) /= IMAG(z);
+        IMAG(z) = -1/IMAG(z);
+    }
+    return z;
+}
+
+static inline dtype c_square(dtype x) {
+    dtype z;
+    REAL(z) = REAL(x)*REAL(x)-IMAG(x)*IMAG(x);
+    IMAG(z) = 2*REAL(x)*IMAG(x);
+    return z;
+}
+
+static inline dtype c_sqrt(dtype x) {
+    dtype z;
+    rtype xr, xi, r;
+    xr = REAL(x)/2;
+    xi = IMAG(x)/2;
+    r  = r_hypot(xr,xi);
+    if (xr>0) {
+        REAL(z) = sqrt(r+xr);
+        IMAG(z) = xi/REAL(z);
+    } else if ( (r-=xr)!=0 ) {
+        IMAG(z) = (xi>=0) ? sqrt(r):-sqrt(r);
+        REAL(z) = xi/IMAG(z);
+    } else {
+        REAL(z) = IMAG(z) = 0;
+    }
+    return z;
+}
+
+static inline dtype c_log(dtype x) {
+    dtype z;
+    REAL(z) = r_log(r_hypot(REAL(x),IMAG(x)));
+    IMAG(z) = r_atan2(IMAG(x),REAL(x));
+    return z;
+}
+
+static inline dtype c_log2(dtype x) {
+    dtype z;
+    z = c_log(x);
+    z = c_mul_r(x,M_LOG2E);
+    return z;
+}
+
+static inline dtype c_log10(dtype x) {
+    dtype z;
+    z = c_log(x);
+    z = c_mul_r(x,M_LOG10E);
+    return z;
+}
+
+static inline dtype c_exp(dtype x) {
+    dtype z;
+    rtype a = r_exp(REAL(x));
+    REAL(z) = a*r_cos(IMAG(x));
+    IMAG(z) = a*r_sin(IMAG(x));
+    return z;
+}
+
+static inline dtype c_exp2(dtype x) {
+    dtype z;
+    rtype a = r_exp(REAL(x)*M_LN2);
+    REAL(z) = a*r_cos(IMAG(x));
+    IMAG(z) = a*r_sin(IMAG(x));
+    return z;
+}
+
+static inline dtype c_exp10(dtype x) {
+    dtype z;
+    rtype a = r_exp(REAL(x)*M_LN10);
+    REAL(z) = a*r_cos(IMAG(x));
+    IMAG(z) = a*r_sin(IMAG(x));
+    return z;
+}
+
+static inline dtype c_sin(dtype x) {
+    dtype z;
+    REAL(z) = r_sin(REAL(x))*r_cosh(IMAG(x));
+    IMAG(z) = r_cos(REAL(x))*r_sinh(IMAG(x));
+    return z;
+}
+
+static inline dtype c_sinh(dtype x) {
+    dtype z;
+    REAL(z) = r_sinh(REAL(x))*r_cos(IMAG(x));
+    IMAG(z) = r_cosh(REAL(x))*r_sin(IMAG(x));
+    return z;
+}
+
+static inline dtype c_cos(dtype x) {
+    dtype z;
+    REAL(z) = r_cos(REAL(x))*r_cosh(IMAG(x));
+    IMAG(z) = -r_sin(REAL(x))*r_sinh(IMAG(x));
+    return z;
+}
+
+static inline dtype c_cosh(dtype x) {
+    dtype z;
+    REAL(z) = r_cosh(REAL(x))*r_cos(IMAG(x));
+    IMAG(z) = r_sinh(REAL(x))*r_sin(IMAG(x));
+    return z;
+}
+
+static inline dtype c_tan(dtype x) {
+    dtype z;
+    rtype c, d;
+    if (r_abs(IMAG(x))<1) {
+        c = r_cos(REAL(x));
+        d = r_sinh(IMAG(x));
+        d = c*c + d*d;
+        REAL(z) = 0.5*r_sin(2*REAL(x))/d;
+        IMAG(z) = 0.5*r_sinh(2*IMAG(x))/d;
+    } else {
+        d = r_exp(-IMAG(x));
+        c = 2*d/(1-d*d);
+        c = c*c;
+        d = r_cos(REAL(x));
+        d = 1.0 + d*d*c;
+        REAL(z) = 0.5*r_sin(2*REAL(x))*c/d;
+        IMAG(z) = 1/r_tanh(IMAG(x))/d;
+    }
+    return z;
+}
+
+static inline dtype c_tanh(dtype x) {
+    dtype z;
+    rtype c, d, s;
+    c = r_cos(IMAG(x));
+    s = r_sinh(REAL(x));
+    d = c*c + s*s;
+    if (r_abs(REAL(x))<1) {
+        REAL(z) = s*r_cosh(REAL(x))/d;
+        IMAG(z) = 0.5*r_sin(2*IMAG(x))/d;
+    } else {
+        c = c / s;
+        c = 1 + c*c;
+        REAL(z) = 1/(r_tanh(REAL(x))*c);
+        IMAG(z) = 0.5*r_sin(2*IMAG(x))/d;
+    }
+    return z;
+}
+
+static inline dtype c_asin(dtype x) {
+    dtype z, y;
+    y = c_square(x);
+    REAL(y) = 1-REAL(y);
+    IMAG(y) = -IMAG(y);
+    y = c_sqrt(y);
+    REAL(y) -= IMAG(x);
+    IMAG(y) += REAL(x);
+    y = c_log(y);
+    REAL(z) = IMAG(y);
+    IMAG(z) = -REAL(y);
+    return z;
+}
+
+static inline dtype c_asinh(dtype x) {
+    dtype z, y;
+    y = c_square(x);
+    REAL(y) += 1;
+    y = c_sqrt(y);
+    REAL(y) += REAL(x);
+    IMAG(y) += IMAG(x);
+    z = c_log(y);
+    return z;
+}
+
+static inline dtype c_acos(dtype x) {
+    dtype z, y;
+    y = c_square(x);
+    REAL(y) = 1-REAL(y);
+    IMAG(y) = -IMAG(y);
+    y = c_sqrt(y);
+    REAL(z) = REAL(x)-IMAG(y);
+    IMAG(z) = IMAG(x)+REAL(y);
+    y = c_log(z);
+    REAL(z) = IMAG(y);
+    IMAG(z) = -REAL(y);
+    return z;
+}
+
+static inline dtype c_acosh(dtype x) {
+    dtype z, y;
+    y = c_square(x);
+    REAL(y) -= 1;
+    y = c_sqrt(y);
+    REAL(y) += REAL(x);
+    IMAG(y) += IMAG(x);
+    z = c_log(y);
+    return z;
+}
+
+static inline dtype c_atan(dtype x) {
+    dtype z, y;
+    REAL(y) = -REAL(x);
+    IMAG(y) = 1-IMAG(x);
+    REAL(z) = REAL(x);
+    IMAG(z) = 1+IMAG(x);
+    y = c_div(z,y);
+    y = c_log(y);
+    REAL(z) = -IMAG(y)/2;
+    IMAG(z) = REAL(y)/2;
+    return z;
+}
+
+static inline dtype c_atanh(dtype x) {
+    dtype z, y;
+    REAL(y) = 1-REAL(x);
+    IMAG(y) = -IMAG(x);
+    REAL(z) = 1+REAL(x);
+    IMAG(z) = IMAG(x);
+    y = c_div(z,y);
+    y = c_log(y);
+    REAL(z) = REAL(y)/2;
+    IMAG(z) = IMAG(y)/2;
+    return z;
+}
+
+static inline dtype c_pow(dtype x, dtype y)
+{
+    dtype z;
+    if (c_is_zero(y)) {
+        z = c_one();
+    } else if (c_is_zero(x) && REAL(y)>0 && IMAG(y)==0) {
+        z = c_zero();
+    } else {
+        z = c_log(x);
+        z = c_mul(y,z);
+        z = c_exp(z);
+    }
+    return z;
+}
+
+static inline dtype c_pow_int(dtype x, int p)
+{
+    dtype z = c_one();
+    if (p<0) {
+	x = c_pow_int(x,-p);
+	return c_inverse(x);
+    }
+    if (p==2) {return c_square(x);}
+    if (p&1) {z = x;}
+    p >>= 1;
+    while (p) {
+	x = c_square(x);
+	if (p&1) z = c_mul(z,x);
+	p >>= 1;
+    }
+    return z;
+}
+
+static inline dtype c_cbrt(dtype x) {
+    dtype z;
+    z = c_log(x);
+    z = c_div_r(z,3);
+    z = c_exp(z);
+    return z;
+}
+
+static inline rtype c_abs(dtype x) {
+    return r_hypot(REAL(x),IMAG(x));
+}
+
+static inline rtype c_abs_square(dtype x) {
+    return REAL(x)*REAL(x)+IMAG(x)*IMAG(x);
+}
+
+
+
+/*
+static inline rtype c_hypot(dtype x, dtype y) {
+    return r_hypot(c_abs(x),c_abs(y));
+}
+*/