carray 3.0.2 → 3.0.4

data/ext/carray_kernels_moncmp.c

@@ -24,6 +24,13 @@
    probed by operation-table function pointer (obj_type is runtime-
    assigned, so no CA_OBJ_STACK compile-time constant exists). */
 extern ca_operation_function_t ca_stack_func;
+/* The square root of a variance: an ε-negative from rounding becomes 0,
+   a NaN stays NaN (fmax(NaN, 0.0) is 0.0). */
+#ifndef CARRAY_SQRT_CLAMP_DEFINED
+#define CARRAY_SQRT_CLAMP_DEFINED
+static inline double ca_sqrt_clamp (double v) { return sqrt(v < 0.0 ? 0.0 : v); }
+#endif
+
 /* BOOL2VAL: bool -> Ruby (Qtrue/Qfalse).  Used as ruby_scalar wrapper
    for the all/any flat-reduction Ruby surface so `a.all` / `a.any`
    return real true/false, not Integer 0/1.  (BOOL2OBJ already exists
@@ -416,14 +423,14 @@ ca_moncmp_is_nan_VALUE (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { (*p2) = rb_funcall((*p1), rb_intern("nan?"), 0); }
+        { (*p2) = RB_FLOAT_TYPE_P(*p1) ? isnan(RFLOAT_VALUE(*p1)) : (RB_INTEGER_TYPE_P(*p1) || RB_TYPE_P((*p1), T_RATIONAL)) ? 0 : RTEST(rb_funcall((*p1), rb_intern("nan?"), 0)); }
       }
     }
   } else {
     for (k=0; k<n; k++) {
       p1 = q1 + k*i1;
       p2 = q2 + k*i2;
-      { (*p2) = rb_funcall((*p1), rb_intern("nan?"), 0); }
+      { (*p2) = RB_FLOAT_TYPE_P(*p1) ? isnan(RFLOAT_VALUE(*p1)) : (RB_INTEGER_TYPE_P(*p1) || RB_TYPE_P((*p1), T_RATIONAL)) ? 0 : RTEST(rb_funcall((*p1), rb_intern("nan?"), 0)); }
     }
   }
 }
@@ -832,14 +839,14 @@ ca_moncmp_is_inf_VALUE (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { (*p2) = rb_funcall((*p1), rb_intern("infinite?"), 0); }
+        { (*p2) = RTEST(rb_funcall((*p1), rb_intern("infinite?"), 0)); }
       }
     }
   } else {
     for (k=0; k<n; k++) {
       p1 = q1 + k*i1;
       p2 = q2 + k*i2;
-      { (*p2) = rb_funcall((*p1), rb_intern("infinite?"), 0); }
+      { (*p2) = RTEST(rb_funcall((*p1), rb_intern("infinite?"), 0)); }
     }
   }
 }
@@ -1248,14 +1255,14 @@ ca_moncmp_is_finite_VALUE (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { (*p2) = rb_funcall((*p1), rb_intern("finite?"), 0); }
+        { (*p2) = RTEST(rb_funcall((*p1), rb_intern("finite?"), 0)); }
       }
     }
   } else {
     for (k=0; k<n; k++) {
       p1 = q1 + k*i1;
       p2 = q2 + k*i2;
-      { (*p2) = rb_funcall((*p1), rb_intern("finite?"), 0); }
+      { (*p2) = RTEST(rb_funcall((*p1), rb_intern("finite?"), 0)); }
     }
   }
 }
@@ -2050,14 +2057,14 @@ ca_moncmp_signbit_VALUE (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { (*p2) = (RTEST(rb_funcall((*p1), rb_intern("negative?"), 0)) ? 1 : 0); }
+        { (*p2) = RB_FLOAT_TYPE_P(*p1) ? (signbit(RFLOAT_VALUE(*p1)) != 0) : (RTEST(rb_funcall((*p1), rb_intern("negative?"), 0)) ? 1 : 0); }
       }
     }
   } else {
     for (k=0; k<n; k++) {
       p1 = q1 + k*i1;
       p2 = q2 + k*i2;
-      { (*p2) = (RTEST(rb_funcall((*p1), rb_intern("negative?"), 0)) ? 1 : 0); }
+      { (*p2) = RB_FLOAT_TYPE_P(*p1) ? (signbit(RFLOAT_VALUE(*p1)) != 0) : (RTEST(rb_funcall((*p1), rb_intern("negative?"), 0)) ? 1 : 0); }
     }
   }
 }

data/ext/carray_kernels_monop.c

@@ -24,6 +24,13 @@
    probed by operation-table function pointer (obj_type is runtime-
    assigned, so no CA_OBJ_STACK compile-time constant exists). */
 extern ca_operation_function_t ca_stack_func;
+/* The square root of a variance: an ε-negative from rounding becomes 0,
+   a NaN stays NaN (fmax(NaN, 0.0) is 0.0). */
+#ifndef CARRAY_SQRT_CLAMP_DEFINED
+#define CARRAY_SQRT_CLAMP_DEFINED
+static inline double ca_sqrt_clamp (double v) { return sqrt(v < 0.0 ? 0.0 : v); }
+#endif
+
 /* BOOL2VAL: bool -> Ruby (Qtrue/Qfalse).  Used as ruby_scalar wrapper
    for the all/any flat-reduction Ruby surface so `a.all` / `a.any`
    return real true/false, not Integer 0/1.  (BOOL2OBJ already exists
@@ -3857,6 +3864,51 @@ ca_monop_abs_cmplx128_t (ca_size_t n, boolean8_t *m,
   }
 }
 
+static void
+ca_monop_abs_VALUE (ca_size_t n, boolean8_t *m,
+                                 char * __restrict__ ptr1, ca_size_t i1,
+                                 char * __restrict__ ptr2, ca_size_t i2)
+{
+  VALUE  * __restrict__ q1 = (VALUE  *) ptr1;
+  VALUE * __restrict__ q2 = (VALUE *) ptr2;
+  ca_size_t k;
+  if ( m ) {
+    VALUE  *p1 = q1;
+    VALUE *p2 = q2;
+    boolean8_t *pm;
+    for (k=0; k<n; k++) {
+      pm = m + k;
+      if ( ! *pm ) {
+        p1 = q1 + k*i1;
+        p2 = q2 + k*i2;
+        { (*p2) = rb_funcall((*p1), rb_intern("abs"), 0); }
+      }
+    }
+  } else if ( i1 == 1 && i2 == 1 ) {
+    /* contig branch: SIMD-friendly form.  Index-form `q[k]` exposes
+       the unit-stride access to the vectorizer; `__restrict__` on
+       q1/q2 promises no aliasing so the omp simd pragma can license
+       lane-parallel loads/stores.  Element-wise monop has no
+       reassoc, so ε-close numeric contract is unaffected. */
+    VALUE  *p1;
+    VALUE *p2;
+    (void)p1; (void)p2;
+    #pragma omp simd
+    for (k=0; k<n; k++) {
+      p1 = q1 + k; p2 = q2 + k;
+      { (*p2) = rb_funcall((*p1), rb_intern("abs"), 0); }
+    }
+  } else {
+    /* strided branch: numo-shape `p += s` increment form. */
+    VALUE  *p1 = q1;
+    VALUE *p2 = q2;
+    for (k=0; k<n; k++) {
+      { (*p2) = rb_funcall((*p1), rb_intern("abs"), 0); }
+      p1 += i1; p2 += i2;
+    }
+  }
+}
+
 ca_monop_func_t
 ca_monop_abs[CA_NTYPE] = {
   ca_monop_not_implement,
@@ -3875,7 +3927,7 @@ ca_monop_abs[CA_NTYPE] = {
   ca_monop_abs_cmplx64_t,
   ca_monop_abs_cmplx128_t,
   ca_monop_not_implement,
-  ca_monop_not_implement,
+  ca_monop_abs_VALUE,
 };
 
 int8_t ca_monop_abs_out_data_type[CA_NTYPE] = {
@@ -3895,7 +3947,7 @@ int8_t ca_monop_abs_out_data_type[CA_NTYPE] = {
   CA_FLOAT32,
   CA_FLOAT64,
   -1,
-  -1,
+  CA_OBJECT,
 };
 
 VALUE rb_ca_abs (VALUE self)
@@ -3911,11 +3963,15 @@ VALUE rb_ca_abs_bang (VALUE self)
   int8_t  in_dt;
   TypedData_Get_Struct(self, CArray, &carray_data_type, ca);
   in_dt = ca->data_type;
+  if ( ca_monop_abs_out_data_type[in_dt] <= CA_NONE ) {
+    rb_raise(rb_eCADataTypeError,
+             "abs!: source data_type :%s not supported", ca_type_name[in_dt]);
+  }
   if ( ca_monop_abs_out_data_type[in_dt] != in_dt ) {
-    rb_raise(rb_eRuntimeError,
-             "abs!: in-place form is not available when output "
-             "data_type differs from input (input data_type %d -> output data_type %d); "
-             "use non-bang form", in_dt, ca_monop_abs_out_data_type[in_dt]);
+    rb_raise(rb_eCADataTypeError,
+             "abs!: abs of :%s is :%s, which cannot be written back in place; "
+             "use abs", ca_type_name[in_dt],
+             ca_type_name[ca_monop_abs_out_data_type[in_dt]]);
   }
   return rb_ca_call_monop_bang(self, ca_monop_abs);
 }
@@ -4519,11 +4575,15 @@ VALUE rb_ca_abs2_bang (VALUE self)
   int8_t  in_dt;
   TypedData_Get_Struct(self, CArray, &carray_data_type, ca);
   in_dt = ca->data_type;
+  if ( ca_monop_abs2_out_data_type[in_dt] <= CA_NONE ) {
+    rb_raise(rb_eCADataTypeError,
+             "abs2!: source data_type :%s not supported", ca_type_name[in_dt]);
+  }
   if ( ca_monop_abs2_out_data_type[in_dt] != in_dt ) {
-    rb_raise(rb_eRuntimeError,
-             "abs2!: in-place form is not available when output "
-             "data_type differs from input (input data_type %d -> output data_type %d); "
-             "use non-bang form", in_dt, ca_monop_abs2_out_data_type[in_dt]);
+    rb_raise(rb_eCADataTypeError,
+             "abs2!: abs2 of :%s is :%s, which cannot be written back in place; "
+             "use abs2", ca_type_name[in_dt],
+             ca_type_name[ca_monop_abs2_out_data_type[in_dt]]);
   }
   return rb_ca_call_monop_bang(self, ca_monop_abs2);
 }
@@ -6361,11 +6421,15 @@ VALUE rb_ca_arg_bang (VALUE self)
   int8_t  in_dt;
   TypedData_Get_Struct(self, CArray, &carray_data_type, ca);
   in_dt = ca->data_type;
+  if ( ca_monop_arg_out_data_type[in_dt] <= CA_NONE ) {
+    rb_raise(rb_eCADataTypeError,
+             "arg!: source data_type :%s not supported", ca_type_name[in_dt]);
+  }
   if ( ca_monop_arg_out_data_type[in_dt] != in_dt ) {
-    rb_raise(rb_eRuntimeError,
-             "arg!: in-place form is not available when output "
-             "data_type differs from input (input data_type %d -> output data_type %d); "
-             "use non-bang form", in_dt, ca_monop_arg_out_data_type[in_dt]);
+    rb_raise(rb_eCADataTypeError,
+             "arg!: arg of :%s is :%s, which cannot be written back in place; "
+             "use arg", ca_type_name[in_dt],
+             ca_type_name[ca_monop_arg_out_data_type[in_dt]]);
   }
   return rb_ca_call_monop_bang(self, ca_monop_arg);
 }
@@ -6929,7 +6993,7 @@ ca_monop_arg_i_float32_t (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { (*p2) = cargf((cmplx64_t)(*p1)); }
+        { (*p2) = carg((cmplx128_t)(*p1)); }
       }
     }
   } else if ( i1 == 1 && i2 == 1 ) {
@@ -6944,14 +7008,14 @@ ca_monop_arg_i_float32_t (ca_size_t n, boolean8_t *m,
     #pragma omp simd
     for (k=0; k<n; k++) {
       p1 = q1 + k; p2 = q2 + k;
-      { (*p2) = cargf((cmplx64_t)(*p1)); }
+      { (*p2) = carg((cmplx128_t)(*p1)); }
     }
   } else {
     /* strided branch: numo-shape `p += s` increment form. */
     float  *p1 = q1;
     float *p2 = q2;
     for (k=0; k<n; k++) {
-      { (*p2) = cargf((cmplx64_t)(*p1)); }
+      { (*p2) = carg((cmplx128_t)(*p1)); }
       p1 += i1; p2 += i2;
     }
   }
@@ -9079,7 +9143,7 @@ ca_monop_round_float32_t (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { (*p2) = ((*p1)>0.0) ? floor((*p1)+0.5) : ((*p1)<0.0) ? ceil((*p1)-0.5) : (*p1); }
+        { (*p2) = round(*p1); }
       }
     }
   } else if ( i1 == 1 && i2 == 1 ) {
@@ -9094,14 +9158,14 @@ ca_monop_round_float32_t (ca_size_t n, boolean8_t *m,
     #pragma omp simd
     for (k=0; k<n; k++) {
       p1 = q1 + k; p2 = q2 + k;
-      { (*p2) = ((*p1)>0.0) ? floor((*p1)+0.5) : ((*p1)<0.0) ? ceil((*p1)-0.5) : (*p1); }
+      { (*p2) = round(*p1); }
     }
   } else {
     /* strided branch: numo-shape `p += s` increment form. */
     float  *p1 = q1;
     float *p2 = q2;
     for (k=0; k<n; k++) {
-      { (*p2) = ((*p1)>0.0) ? floor((*p1)+0.5) : ((*p1)<0.0) ? ceil((*p1)-0.5) : (*p1); }
+      { (*p2) = round(*p1); }
       p1 += i1; p2 += i2;
     }
   }
@@ -9124,7 +9188,7 @@ ca_monop_round_float64_t (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { (*p2) = ((*p1)>0.0) ? floor((*p1)+0.5) : ((*p1)<0.0) ? ceil((*p1)-0.5) : (*p1); }
+        { (*p2) = round(*p1); }
       }
     }
   } else if ( i1 == 1 && i2 == 1 ) {
@@ -9139,14 +9203,14 @@ ca_monop_round_float64_t (ca_size_t n, boolean8_t *m,
     #pragma omp simd
     for (k=0; k<n; k++) {
       p1 = q1 + k; p2 = q2 + k;
-      { (*p2) = ((*p1)>0.0) ? floor((*p1)+0.5) : ((*p1)<0.0) ? ceil((*p1)-0.5) : (*p1); }
+      { (*p2) = round(*p1); }
     }
   } else {
     /* strided branch: numo-shape `p += s` increment form. */
     double  *p1 = q1;
     double *p2 = q2;
     for (k=0; k<n; k++) {
-      { (*p2) = ((*p1)>0.0) ? floor((*p1)+0.5) : ((*p1)<0.0) ? ceil((*p1)-0.5) : (*p1); }
+      { (*p2) = round(*p1); }
       p1 += i1; p2 += i2;
     }
   }
@@ -9246,7 +9310,7 @@ ca_monop_rcp_int8_t (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+        { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
       }
     }
   } else if ( i1 == 1 && i2 == 1 ) {
@@ -9261,14 +9325,14 @@ ca_monop_rcp_int8_t (ca_size_t n, boolean8_t *m,
     #pragma omp simd
     for (k=0; k<n; k++) {
       p1 = q1 + k; p2 = q2 + k;
-      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
     }
   } else {
     /* strided branch: numo-shape `p += s` increment form. */
     int8_t  *p1 = q1;
     int8_t *p2 = q2;
     for (k=0; k<n; k++) {
-      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
       p1 += i1; p2 += i2;
     }
   }
@@ -9336,7 +9400,7 @@ ca_monop_rcp_int16_t (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+        { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
       }
     }
   } else if ( i1 == 1 && i2 == 1 ) {
@@ -9351,14 +9415,14 @@ ca_monop_rcp_int16_t (ca_size_t n, boolean8_t *m,
     #pragma omp simd
     for (k=0; k<n; k++) {
       p1 = q1 + k; p2 = q2 + k;
-      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
     }
   } else {
     /* strided branch: numo-shape `p += s` increment form. */
     int16_t  *p1 = q1;
     int16_t *p2 = q2;
     for (k=0; k<n; k++) {
-      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
       p1 += i1; p2 += i2;
     }
   }
@@ -9426,7 +9490,7 @@ ca_monop_rcp_int32_t (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+        { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
       }
     }
   } else if ( i1 == 1 && i2 == 1 ) {
@@ -9441,14 +9505,14 @@ ca_monop_rcp_int32_t (ca_size_t n, boolean8_t *m,
     #pragma omp simd
     for (k=0; k<n; k++) {
       p1 = q1 + k; p2 = q2 + k;
-      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
     }
   } else {
     /* strided branch: numo-shape `p += s` increment form. */
     int32_t  *p1 = q1;
     int32_t *p2 = q2;
     for (k=0; k<n; k++) {
-      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
       p1 += i1; p2 += i2;
     }
   }
@@ -9516,7 +9580,7 @@ ca_monop_rcp_int64_t (ca_size_t n, boolean8_t *m,
       if ( ! *pm ) {
         p1 = q1 + k*i1;
         p2 = q2 + k*i2;
-        { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+        { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
       }
     }
   } else if ( i1 == 1 && i2 == 1 ) {
@@ -9531,14 +9595,14 @@ ca_monop_rcp_int64_t (ca_size_t n, boolean8_t *m,
     #pragma omp simd
     for (k=0; k<n; k++) {
       p1 = q1 + k; p2 = q2 + k;
-      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
     }
   } else {
     /* strided branch: numo-shape `p += s` increment form. */
     int64_t  *p1 = q1;
     int64_t *p2 = q2;
     for (k=0; k<n; k++) {
-      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = 1/(*p1); }
+      { if ((*p1)==0) {ca_zerodiv();}; (*p2) = ((*p1)==1) ? 1 : ((*p1) < 0) ? -1 : 0; }
       p1 += i1; p2 += i2;
     }
   }
@@ -15487,9 +15551,6 @@ VALUE rb_ca_expm1 (VALUE self)
 VALUE rb_ca_expm1_bang (VALUE self)
 { return rb_ca_call_monop_bang(self, ca_monop_expm1); }
 
-VALUE rb_cmath_expm1 (VALUE mod, VALUE arg)
-{ return ca_math_call(mod, arg, rb_intern("expm1")); }
-
 /* ===== monop log1p ============================================ */
 
 static void
@@ -15683,9 +15744,6 @@ VALUE rb_ca_log1p (VALUE self)
 VALUE rb_ca_log1p_bang (VALUE self)
 { return rb_ca_call_monop_bang(self, ca_monop_log1p); }
 
-VALUE rb_cmath_log1p (VALUE mod, VALUE arg)
-{ return ca_math_call(mod, arg, rb_intern("log1p")); }
-
 /* ===== monop rsqrt ============================================ */
 
 static void
@@ -18285,10 +18343,8 @@ Init_carray_kernels_monop (void)
   rb_define_module_function(rb_mCAMath, "atanh", rb_cmath_atanh, 1);
   rb_define_method(rb_cCArray, "expm1", rb_ca_expm1, 0);
   rb_define_method(rb_cCArray, "expm1!", rb_ca_expm1_bang, 0);
-  rb_define_module_function(rb_mCAMath, "expm1", rb_cmath_expm1, 1);
   rb_define_method(rb_cCArray, "log1p", rb_ca_log1p, 0);
   rb_define_method(rb_cCArray, "log1p!", rb_ca_log1p_bang, 0);
-  rb_define_module_function(rb_mCAMath, "log1p", rb_cmath_log1p, 1);
   rb_define_method(rb_cCArray, "rsqrt", rb_ca_rsqrt, 0);
   rb_define_method(rb_cCArray, "rsqrt!", rb_ca_rsqrt_bang, 0);
   rb_define_module_function(rb_mCAMath, "rsqrt", rb_cmath_rsqrt, 1);