carray 1.3.7 → 1.5.4

data/{carray_order.c → ext/carray_order.c}

@@ -3,10 +3,8 @@
   carray_order.c
 
   This file is part of Ruby/CArray extension library.
-  You can redistribute it and/or modify it under the terms of
-  the Ruby Licence.
 
-  Copyright (C) 2005 Hiroki Motoyoshi
+  Copyright (C) 2005-2020 Hiroki Motoyoshi
 
 ---------------------------------------------------------------------------- */
 
@@ -132,7 +130,7 @@ ca_project (CArray *ca, CArray *ci, char *lfill, char *ufill)
 
   ca_attach_n(2, ca, ci); /* ATTACH */
 
-  co = carray_new(ca->data_type, ci->rank, ci->dim, ca->bytes, NULL);
+  co = carray_new(ca->data_type, ci->ndim, ci->dim, ca->bytes, NULL);
   ca_project_loop(co, ca, ci, lfill, ufill);
 
   ca_detach_n(2, ca, ci); /* DETACH */
@@ -140,26 +138,24 @@ ca_project (CArray *ca, CArray *ci, char *lfill, char *ufill)
   return co;
 }
 
-/* rdoc:
-  class CArray
-    def project (idx,lval=nil,uval=nil)
-    end
-  end
+/* @overload project (idx, lval=nil, uval=nil)
+
+[TBD]. Creates new array the element of the object as address.
 */
 
 VALUE
 rb_ca_project (int argc, VALUE *argv, VALUE self)
 {
-  volatile VALUE obj, rindex, vlfval, vufval;
+  volatile VALUE obj, ridx, vlfval, vufval;
   CArray *ca, *ci, *co;
   char *lfval, *ufval;
 
-  rb_scan_args(argc, argv, "12", (VALUE *) &rindex, (VALUE *) &vlfval, (VALUE *) &vufval);
+  rb_scan_args(argc, argv, "12", (VALUE *)&ridx, (VALUE *) &vlfval, (VALUE *) &vufval);
 
   Data_Get_Struct(self, CArray, ca);
 
-  rb_check_carray_object(rindex);
-  ci = ca_wrap_readonly(rindex, CA_SIZE);
+  rb_check_carray_object(ridx);
+  ci = ca_wrap_readonly(ridx, CA_SIZE);
 
   lfval = malloc_with_check(ca->bytes);
   ufval = malloc_with_check(ca->bytes);
@@ -227,12 +223,9 @@ rb_ca_project (int argc, VALUE *argv, VALUE self)
     free(v);                                            \
   }
 
-/* rdoc:
-  class CArray
-    # Reverses the elements of +ca+ in place.
-    def reverse!
-    end
-  end
+/* @overload reverse!
+
+Reverses the elements of +ca+ in place.
 */
 
 static VALUE
@@ -279,13 +272,10 @@ rb_ca_reverse_bang (VALUE self)
   return self;
 }
 
-/* rdoc:
-  class CArray
-    # Returns a new CArray object containing <i>ca</i>'s elements in
-    # reverse order.
-    def reverse
-    end
-  end
+/* @overload reverse
+
+Returns a new CArray object containing <i>ca</i>'s elements in
+reverse order.
 */
 
 static VALUE
@@ -384,12 +374,9 @@ ca_qsort_cmp[CA_NTYPE] = {
   qcmp_VALUE,
 };
 
-/* rdoc:
-  class CArray
-    # Sorts <i>ca</i>'s elements in place.
-    def sort!
-    end
-  end
+/* @overload sort!
+
+Sorts <i>ca</i>'s elements in place.
 */
 
 static VALUE
@@ -433,12 +420,9 @@ rb_ca_sort_bang (VALUE self)
   return self;
 }
 
-/* rdoc:
-  class CArray
-    # Returns a new CArray object containing <i>ca</i>'s elements sorted.
-    def sort
-    end
-  end
+/* @overload sort
+
+Returns a new CArray object containing <i>ca</i>'s elements sorted.
 */
 
 static VALUE
@@ -449,162 +433,12 @@ rb_ca_sorted_copy (VALUE self)
   return rb_ca_sort_bang(out);
 }
 
-/* --------------------------------------------------------------- */
-
-/*
-  Fisher-Yates method
-
-  # [ruby-list:41356]
-  # From: Shin-ichiro HARA <sinara blade.nagaokaut.ac.jp>
-  def shuffle!
-    array = self
-    array.each_index do |idx|
-      jdx = rand(idx + 1)
-      array[idx], array[jdx] = array[jdx], array[idx]
-    end
-    self
-  end
-*/
-
-#define proc_shuffle(type)                      \
-  {                                             \
-    ca_size_t idx, jdx;                           \
-    type *ptr, *p, *q;                          \
-    type t1;                                    \
-    ptr = (type *) ca->ptr;                     \
-    if ( ca->mask ) {                           \
-      boolean8_t *mptr, *mp, *mq;                \
-      boolean8_t mt1;                            \
-      mptr = (boolean8_t *)ca->mask->ptr;        \
-      for (idx=0; idx<ca->elements; idx++) {    \
-        jdx = ca_rand((double)(idx+1));         \
-        p = ptr + idx;                          \
-        q = ptr + jdx;                          \
-        mp = mptr + idx;                        \
-        mq = mptr + jdx;                        \
-        t1 = *p; *p = *q; *q = t1;              \
-        mt1 = *mp; *mp = *mq; *mq = mt1;        \
-      }                                         \
-    }                                           \
-    else {                                      \
-      for (idx=0; idx<ca->elements; idx++) {    \
-        jdx = ca_rand((double)(idx+1));         \
-        p = ptr + idx;                          \
-        q = ptr + jdx;                          \
-        t1 = *p; *p = *q; *q = t1;              \
-      }                                         \
-    }                                           \
-  }
-
-#define proc_shuffle_fixlen()                   \
-  {                                             \
-    ca_size_t idx, jdx;                           \
-    char *ptr, *p, *q;                          \
-    char *t = (char*) malloc_with_check(ca->bytes); \
-    ca_size_t bytes = ca->bytes;                  \
-    ptr = ca->ptr;                              \
-    if ( ca->mask ) {                           \
-      boolean8_t *mptr, *mp, *mq;                \
-      boolean8_t mt1;                            \
-      mptr = (boolean8_t *)ca->mask->ptr;        \
-      for (idx=0; idx<ca->elements; idx++) {    \
-        jdx = ca_rand((double)(idx+1));         \
-        p = ca->ptr + idx*bytes;                \
-        q = ca->ptr + jdx*bytes;                \
-        mp = mptr + idx;                        \
-        mq = mptr + jdx;                        \
-        memcpy(t, p, bytes); memcpy(p, q, bytes); memcpy(q, t, bytes);  \
-        mt1 = *mp; *mp = *mq; *mq = mt1;        \
-      }                                                                 \
-      free(t);                                                          \
-    }                                                                   \
-    else {                                      \
-      for (idx=0; idx<ca->elements; idx++) {    \
-        jdx = ca_rand((double)(idx+1));         \
-        p = ca->ptr + idx*bytes;                \
-        q = ca->ptr + jdx*bytes;                                     \
-        memcpy(t, p, bytes); memcpy(p, q, bytes); memcpy(q, t, bytes);  \
-      }                                                                 \
-      free(t);                                                          \
-    }                                                                   \
-  }
-
-void ca_check_rand_init ();
-
-/* rdoc:
-  class CArray
-    # shuffles the elements.
-    # If `self` has mask, the masked elements are also moved by shuffling.
-    def shuffle!
-    end
-  end
-*/
-
-static VALUE
-rb_ca_shuffle_bang (VALUE self)
-{
-  CArray *ca;
-
-  rb_ca_modify(self);
-
-  Data_Get_Struct(self, CArray, ca);
-
-  ca_check_rand_init();
-
-  ca_attach(ca);
-
-  switch ( ca->data_type ) {
-  case CA_BOOLEAN:
-  case CA_INT8:     proc_shuffle(int8_t);     break;
-  case CA_UINT8:    proc_shuffle(uint8_t);   break;
-  case CA_INT16:    proc_shuffle(int16_t);    break;
-  case CA_UINT16:   proc_shuffle(uint16_t);  break;
-  case CA_INT32:    proc_shuffle(int32_t);    break;
-  case CA_UINT32:   proc_shuffle(uint32_t);  break;
-  case CA_INT64:    proc_shuffle(int64_t);    break;
-  case CA_UINT64:   proc_shuffle(uint64_t);  break;
-  case CA_FLOAT32:  proc_shuffle(float32_t);  break;
-  case CA_FLOAT64:  proc_shuffle(float64_t);  break;
-  case CA_FLOAT128: proc_shuffle(float128_t); break;
-#ifdef HAVE_COMPLEX_H
-  case CA_CMPLX64:  proc_shuffle(cmplx64_t);  break;
-  case CA_CMPLX128: proc_shuffle(cmplx128_t); break;
-  case CA_CMPLX256: proc_shuffle(cmplx256_t); break;
-#endif
-  case CA_FIXLEN: proc_shuffle_fixlen();  break;
-  case CA_OBJECT:   proc_shuffle(VALUE);      break;
-  default:
-    rb_raise(rb_eCADataTypeError, "[BUG] array has an unknown data type");
-  }
-
-  ca_sync(ca);
-  ca_detach(ca);
-
-  return self;
-}
-
-/* rdoc:
-  class CArray
-    def shuffle
-    end
-  end
-*/
-
-static VALUE
-rb_ca_shuffled_copy (VALUE self)
-{
-  volatile VALUE out = rb_ca_copy(self);
-  rb_ca_data_type_inherit(out, self);
-  return rb_ca_shuffle_bang(out);
-}
 
 /* --------------------------------------------------------------- */
 
-/* rdoc:
-  class CArray
-    def bsearch
-    end
-  end
+/* @overload bsearch
+
+Returns a new CArray object containing <i>ca</i>'s elements sorted.
 */
 
 static VALUE
@@ -641,7 +475,7 @@ rb_ca_binary_search (VALUE self, volatile VALUE rval)
     if ( ca->data_type != cv->data_type ) {
       cv = ca_wrap_readonly(rval, ca->data_type);
     }
-    co = carray_new(CA_SIZE, cv->rank, cv->dim, 0, NULL);
+    co = carray_new(CA_SIZE, cv->ndim, cv->dim, 0, NULL);
     out = ca_wrap_struct(co);
     ca_attach(cv);
     if ( ca_is_fixlen_type(ca) ) {
@@ -709,11 +543,9 @@ rb_ca_binary_search (VALUE self, volatile VALUE rval)
   return out;
 }
 
-/* rdoc:
-  class CArray
-    def bsearch_index
-    end
-  end
+/* @overload bsearch_index
+
+[TBD]. 
 */
 
 static VALUE
@@ -778,6 +610,33 @@ rb_ca_binary_search_index (VALUE self, volatile VALUE rval)
     }                                                        \
   }
 
+#define proc_find_value_float128(type, defeps)                  \
+  {                                                          \
+    type *ptr = (type *) ca->ptr;                            \
+    boolean8_t *m = (ca->mask) ? (boolean8_t*) ca->mask->ptr : NULL; \
+    type val  = (type) NUM2DBL(value);                       \
+    float128_t eps  = (NIL_P(veps)) ? defeps*fabsl(val) : NUM2DBL(veps); \
+    ca_size_t i;                                               \
+    if ( m ) {                                               \
+      for (i=0; i<ca->elements; i++, ptr++) {                \
+        if ( ! *m++ ) {                                      \
+          if ( fabsl(*ptr - val) <= eps ) {                   \
+            addr = i;                                        \
+            break;                                           \
+          }                                                  \
+        }                                                    \
+      }                                                      \
+    }                                                        \
+    else {                                                   \
+      for (i=0; i<ca->elements; i++, ptr++) {                \
+        if ( fabsl(*ptr - val) <= eps ) {                     \
+          addr = i;                                          \
+          break;                                             \
+        }                                                    \
+      }                                                      \
+    }                                                        \
+  }
+
 #define proc_find_value_cmplx(type, defeps)                  \
   {                                                          \
     type *ptr = (type *) ca->ptr;                            \
@@ -831,11 +690,9 @@ rb_ca_binary_search_index (VALUE self, volatile VALUE rval)
   }
 
 
-/* rdoc:
-  class CArray
-    def search
-    end
-  end
+/* @overload search
+
+[TBD]. 
 */
 
 static VALUE
@@ -865,7 +722,7 @@ rb_ca_linear_search (int argc, VALUE *argv, VALUE self)
   case CA_UINT64:   proc_find_value(uint64_t); break;
   case CA_FLOAT32:  proc_find_value_float(float32_t, FLT_EPSILON); break;
   case CA_FLOAT64:  proc_find_value_float(float64_t, DBL_EPSILON); break;
-  case CA_FLOAT128: proc_find_value_float(float128_t, DBL_EPSILON); break;
+  case CA_FLOAT128: proc_find_value_float128(float128_t, DBL_EPSILON); break;
 #ifdef HAVE_COMPLEX_H
   case CA_CMPLX64:  proc_find_value_cmplx(cmplx64_t, FLT_EPSILON); break;
   case CA_CMPLX128: proc_find_value_cmplx(cmplx128_t, DBL_EPSILON); break;
@@ -881,11 +738,9 @@ rb_ca_linear_search (int argc, VALUE *argv, VALUE self)
   return ( addr == -1 ) ? Qnil : SIZE2NUM(addr);
 }
 
-/* rdoc:
-  class CArray
-    def search_index
-    end
-  end
+/* @overload search_index
+
+[TBD]. 
 */
 
 static VALUE
@@ -959,11 +814,9 @@ rb_ca_linear_search_index (int argc, VALUE *argv, VALUE self)
     }                                                   \
   }
 
-/* rdoc:
-  class CArray
-    def search_nearest
-    end
-  end
+/* @overload search_nearest
+
+[TBD]. 
 */
 
 static VALUE
@@ -1004,6 +857,11 @@ rb_ca_linear_search_nearest (VALUE self, VALUE value)
   return ( addr == -1 ) ? Qnil : SIZE2NUM(addr);
 }
 
+/* @overload search_nearest_index
+
+[TBD]. 
+*/
+
 static VALUE
 rb_ca_linear_search_nearest_index (VALUE self, VALUE value)
 {
@@ -1011,6 +869,162 @@ rb_ca_linear_search_nearest_index (VALUE self, VALUE value)
   return ( NIL_P(raddr) ) ? Qnil : rb_ca_addr2index(self, raddr);
 }
 
+/* ----------------------------------------------------------------- */
+
+static ca_size_t
+linear_index (ca_size_t n, double *y, double yy, double *idx)
+{
+  ca_size_t a, b, c, x1;
+  double ya, yb, yc;
+  double y1, y2;
+  double rest;
+
+  if ( yy <= y[0] ) {
+    x1 = 0;
+    goto found;
+  }
+
+  if ( yy >= y[n-1] ) {
+    x1 = n-2;
+    goto found;
+  }
+
+  /* check for equally spaced scale */
+
+  a = (ca_size_t)((yy-y[0])/(y[n-1]-y[0])*(n-1));
+
+  if ( a >= 0 && a < n-1 ) {
+    if ( (y[a] - yy) * (y[a+1] - yy) <= 0 ) { /* lucky case */
+      x1 = a;
+      goto found; 
+    }
+  }
+
+  /* binary section method */
+
+  a = 0;
+  b = n-1;
+
+  ya = y[a];
+  yb = y[b];
+
+  if ( ya > yb ) {
+    return -1; /* input scale array should have accending order */
+  }
+
+  while ( (b - a) >= 1 ) {
+
+    c  = (a + b)/2;
+    yc = y[c];
+    if ( a == c ) {
+      break;
+    }
+
+    if ( yc == yy ) {
+      a = c;
+      break;
+    }
+    else if ( (ya - yy) * (yc - yy) <= 0 ) {
+      b = c;
+      yb = yc;
+    }
+    else {
+      a = c;
+      ya = yc;
+    }
+
+    if ( ya > yb ) {
+      return -1; /* input scale array should have accending order */
+    }
+  }
+
+  x1 = a;
+
+ found:
+
+  y1 = y[x1];
+  y2 = y[x1+1];
+  rest = (yy-y1)/(y2-y1);
+
+  if ( fabs(y2-yy)/fabs(y2) < DBL_EPSILON*100 ) {
+    *idx = (double) (x1 + 1);
+  }
+  else if ( fabs(y1-yy)/fabs(y1) < DBL_EPSILON*100 ) {
+    *idx = (double) x1;
+  }
+  else {
+    *idx = rest + (double) x1;
+  }
+
+  return 0;
+}
+
+static VALUE
+rb_ca_binary_search_linear_index (volatile VALUE self, volatile VALUE vx)
+{
+  volatile VALUE out, out0;
+  CArray *ca, *sc, *cx, *co0, *co;
+  ca_size_t n;
+  double *x;
+  double *px;
+  double *po;
+  ca_size_t i;
+
+  Data_Get_Struct(self, CArray, ca);
+
+  if ( rb_ca_is_any_masked(self) ) {
+    rb_raise(rb_eRuntimeError, "self should not have any masked elements");
+  }
+
+  sc = ca_wrap_readonly(self, CA_FLOAT64);
+  cx = ca_wrap_readonly(vx, CA_FLOAT64);
+
+  co0 = carray_new(ca->data_type, cx->ndim, cx->dim, 0, NULL);
+  out = out0 = ca_wrap_struct(co0);
+  co = ca_wrap_writable(out, CA_FLOAT64);
+
+  ca_attach_n(3, sc, cx, co);
+
+  n = sc->elements;
+  x  = (double*) sc->ptr;
+  px = (double*) cx->ptr;
+  po = (double*) co->ptr;
+
+  ca_update_mask(cx);
+  if ( cx->mask ) {
+    boolean8_t *mx, *mo;
+    ca_create_mask(co);
+    mx = (boolean8_t *) cx->mask->ptr;
+    mo = (boolean8_t *) co->mask->ptr;
+    for (i=0; i<cx->elements; i++) {
+      if ( ! *mx ) {
+        linear_index(n, x, *px, po);
+      }
+      else {
+        *mo = 1;
+      }
+      mx++; mo++; px++, po++;
+    }
+  }
+  else {
+    for (i=0; i<cx->elements; i++) {
+      linear_index(n, x, *px, po);
+      px++, po++;
+    }
+  }
+
+  ca_sync(co);
+  ca_detach_n(3, sc, cx, co);
+
+  if ( rb_ca_is_scalar(vx) ) {
+    return rb_funcall(out0, rb_intern("[]"), 1, INT2NUM(0));
+  }
+  else {
+    return out0;
+  }
+}
+
+
 void
 Init_carray_order ()
 {
@@ -1024,8 +1038,8 @@ Init_carray_order ()
   rb_define_method(rb_cCArray,  "sort!", rb_ca_sort_bang, 0);
   rb_define_method(rb_cCArray,  "sort", rb_ca_sorted_copy, 0);
 
-  rb_define_method(rb_cCArray,  "shuffle!", rb_ca_shuffle_bang, 0);
-  rb_define_method(rb_cCArray,  "shuffle", rb_ca_shuffled_copy, 0);
+  rb_define_method(rb_cCArray,  "bsearch", rb_ca_binary_search, 1);
+  rb_define_method(rb_cCArray,  "bsearch_index", rb_ca_binary_search_index, 1);
 
   rb_define_method(rb_cCArray,  "search", rb_ca_linear_search, -1);
   rb_define_method(rb_cCArray,  "search_index", rb_ca_linear_search_index, -1);
@@ -1035,6 +1049,7 @@ Init_carray_order ()
   rb_define_method(rb_cCArray,  "search_nearest_index",
                                 rb_ca_linear_search_nearest_index, 1);
 
-  rb_define_method(rb_cCArray,  "bsearch", rb_ca_binary_search, 1);
-  rb_define_method(rb_cCArray,  "bsearch_index", rb_ca_binary_search_index, 1);
+  rb_define_method(rb_cCArray,  "section",
+                                rb_ca_binary_search_linear_index, 1);
+
 }