SourceForge has been redesigned. Learn more.
Close

Diff of /src/ov-mp.cc [7258ed] .. [214b68]  Maximize  Restore

Switch to side-by-side view

--- a/src/ov-mp.cc
+++ b/src/ov-mp.cc
@@ -119,9 +119,29 @@
     }
 }
 
+/* proxy for equal_p, regular_p, ... */
 octave_value 
-octave_mp::oct_cmp_proxy (const octave_base_value& a1, const octave_base_value& a2, 
-                            int (*func) (mpfr_srcptr op1, mpfr_srcptr op2))
+octave_mp::oct_monocmp_proxy (const octave_mp& a1, 
+                              int (*func) (mpfr_srcptr op1))
+{
+  return octave_value (func (a1.scalar));
+}
+
+/* proxy for single-value transformations (mapping) */
+octave_value 
+octave_mp::oct_monop_proxy (const octave_mp& a1, 
+                            int (*func) (mpfr_ptr rop, mpfr_srcptr op1, mpfr_rnd_t rnd))
+{
+  octave_mp* retval = new octave_mp(static_cast<long unsigned int> (0), mpfr_get_prec (a1.scalar), rnd); 
+  (void) func (retval->scalar, a1.scalar, rnd);
+  return octave_value (retval);  
+}
+
+/* proxy for two-values comparisons */
+octave_value 
+octave_mp::oct_bincmp_proxy (const octave_base_value& a1, 
+                             const octave_base_value& a2, 
+                             int (*func) (mpfr_srcptr op1, mpfr_srcptr op2))
 {
   const octave_mp *arg1, *arg2; 
   int retval;
@@ -149,8 +169,10 @@
   return octave_value (retval);
 }
 
+/* proxy for two-operands operations */
 octave_value 
-octave_mp::oct_binop_proxy (const octave_base_value& a1, const octave_base_value& a2, 
+octave_mp::oct_binop_proxy (const octave_base_value& a1, 
+                            const octave_base_value& a2, 
                             int (*func) (mpfr_ptr rop, mpfr_srcptr op1, mpfr_srcptr op2, mpfr_rnd_t rnd))
 {
   const octave_mp *arg1, *arg2; 
@@ -187,15 +209,13 @@
 {
   switch (umap)
     {
-    case umap_imag:
-      return 0.0;
       
     case umap_real:
     case umap_conj:
       return this->clone ();
       
       /*
-        This is as mapping func must be developped
+        This is how the mapping func must be developped
         case umap_abs:
         {
         octave_mp* retval = new octave_mp(static_cast<long unsigned int>(0), prec, rnd);
@@ -204,75 +224,113 @@
       }
       */
 
-#define SCALAR_MAPPER(UMAP,FCN)                                         \
+      /* Those are not mappers but predicates */
+#define SCALAR_MAPPER1(UMAP,FCN)                                        \
+      case (umap_ ## UMAP):  {                                          \
+        return bool (mpfr_ ## FCN (scalar));                            \
+      }
+      
+      /* two-args mpfr mappers */
+#define SCALAR_MAPPER2(UMAP,FCN)                                        \
+      case (umap_ ## UMAP):  {                                          \
+        octave_mp* retval = new octave_mp(static_cast<long unsigned int> (0), mpfr_get_prec (scalar), rnd); \
+        (void) mpfr_ ## FCN (retval->scalar, scalar);                   \
+          return octave_value (retval);                                 \
+      }
+
+      /* three-args mpfr func */
+#define SCALAR_MAPPER3(UMAP,FCN)                                        \
       case (umap_ ## UMAP):  {                                          \
         octave_mp* retval = new octave_mp(static_cast<long unsigned int> (0), mpfr_get_prec (scalar), rnd); \
         (void) mpfr_ ## FCN (retval->scalar, scalar, rnd);              \
           return octave_value (retval);                                 \
       }
-      SCALAR_MAPPER (log, log);
-      SCALAR_MAPPER (log2, log2);
-      SCALAR_MAPPER (log10, log10);
-      SCALAR_MAPPER (exp, exp);
-      SCALAR_MAPPER (cos, cos);
-      SCALAR_MAPPER (sin, sin);
-      SCALAR_MAPPER (tan, tan);
-      SCALAR_MAPPER (acos, acos);
-      SCALAR_MAPPER (asin, asin);
-      SCALAR_MAPPER (atan, atan);
-      SCALAR_MAPPER (cosh, cosh);
-      SCALAR_MAPPER (sinh, sinh);
-      SCALAR_MAPPER (tanh, tanh);
-      SCALAR_MAPPER (acosh, acosh);
-      SCALAR_MAPPER (asinh, asinh);
-      SCALAR_MAPPER (atanh, atanh);
+
+      SCALAR_MAPPER3 (abs, abs);
+      SCALAR_MAPPER3 (acos, acos);
+      SCALAR_MAPPER3 (acosh, acosh);
+      SCALAR_MAPPER3 (asin, asin);
+      SCALAR_MAPPER3 (asinh, asinh);
+      SCALAR_MAPPER3 (atan, atan);
+      SCALAR_MAPPER3 (atanh, atanh);
+/*
+%!assert(abs(mpv(-2))==2)
+%!assert(acos(mpv(.5, 256))*3-mpv('pi', 256) < 1e-60) 
+%!assert(atan(mpv(1, 256))*4-mpv('pi', 256) < 1e-120) 
+*/
+      /* umap_cbrt */
+      SCALAR_MAPPER2 (ceil, ceil);
+/*
+%!assert(ceil(mpv(-2.7))==-2)
+%!assert(ceil(mpv(2.7))==3)
+*/
+      /* umap_conj */
+      SCALAR_MAPPER3 (cos, cos); 
+      SCALAR_MAPPER3 (cosh, cosh);
+      SCALAR_MAPPER3 (erf, erf);
+      /* umap_erfinv */
+      /* umap_erfcinv */
+      SCALAR_MAPPER3 (erfc, erfc);
+      /* umap_erfcx */
+      /* umap_erfi */
+      /* umap_dawson */
+      SCALAR_MAPPER3 (exp, exp);
+      SCALAR_MAPPER3 (expm1, expm1);
+    case umap_fix:
+      {
+        octave_mp* retval = new octave_mp(static_cast<long unsigned int>(0), prec, rnd);
+        /* explicitelly asks to round towards zero */
+        (void) mpfr_rint(retval->scalar, scalar, MPFR_RNDZ);
+        return octave_value (retval);
+      }
+/*
+%!assert(fix(mpv(-2.7))==-2)
+%!assert(fix(mpv(2.7))==2)
+*/
+      SCALAR_MAPPER1 (finite, regular_p);
+      SCALAR_MAPPER2 (floor, floor);
+/*
+%!assert(floor(mpv(-2.7))==-3)
+%!assert(floor(mpv(2.7))==2)
+*/
+      SCALAR_MAPPER3 (gamma, gamma);
+      /* umap_imag */
+      SCALAR_MAPPER1 (isinf, inf_p);
+      SCALAR_MAPPER1 (isna, nan_p);
+      SCALAR_MAPPER1 (isnan, nan_p);
+      SCALAR_MAPPER3 (log, log);
+      SCALAR_MAPPER3 (log2, log2);
+      SCALAR_MAPPER3 (log10, log10);
+      SCALAR_MAPPER3 (log1p, log1p);
+      /* umap_real */
+      SCALAR_MAPPER2 (round, round);
+/*
+%!assert(round(mpv(-2.7))==-3)
+%!assert(round(mpv(2.7))==3)
+%!assert(round(mpv(-2.5))==-3)
+%!assert(round(mpv(2.5))==3)
+*/
+    case umap_roundb:
+      {
+        octave_mp* retval = new octave_mp(static_cast<long unsigned int>(0), prec, rnd);
+        /* explicitelly asks to round towards nearest, prefering even */
+        (void) mpfr_rint(retval->scalar, scalar, MPFR_RNDN);
+        return octave_value (retval);
+      }
+/*
+%!assert(roundb(mpv(-10.5))==-10)
+%!assert(roundb(mpv(10.5))==10)
+*/
+    case umap_signum:
+      {
+        return mpfr_sgn (scalar); /* this one is a macro */
+      }
+      SCALAR_MAPPER3 (sin, sin);
+      SCALAR_MAPPER3 (sinh, sinh);
+      SCALAR_MAPPER3 (sqrt, sqrt);
+      SCALAR_MAPPER3 (tan, tan);
+      SCALAR_MAPPER3 (tanh, tanh);
     
-      SCALAR_MAPPER (abs, abs);
-      SCALAR_MAPPER (sqrt, sqrt);
-      /* 
-         SCALAR_MAPPER (acos, rc_acos);
-         SCALAR_MAPPER (acosh, rc_acosh);
-         SCALAR_MAPPER (angle, ::arg);
-         SCALAR_MAPPER (arg, ::arg);
-         SCALAR_MAPPER (asin, rc_asin);
-         SCALAR_MAPPER (asinh, ::asinh);
-         SCALAR_MAPPER (atan, ::atan);
-         SCALAR_MAPPER (atanh, rc_atanh);
-         SCALAR_MAPPER (erf, ::erf);
-         SCALAR_MAPPER (erfinv, ::erfinv);
-         SCALAR_MAPPER (erfcinv, ::erfcinv);
-         SCALAR_MAPPER (erfc, ::erfc);
-         SCALAR_MAPPER (erfcx, ::erfcx);
-         SCALAR_MAPPER (erfi, ::erfi);
-         SCALAR_MAPPER (dawson, ::dawson);
-         SCALAR_MAPPER (gamma, xgamma);
-         SCALAR_MAPPER (lgamma, rc_lgamma);
-         SCALAR_MAPPER (cbrt, ::cbrt);
-         SCALAR_MAPPER (ceil, ::ceil);
-         SCALAR_MAPPER (cos, ::cos);
-         SCALAR_MAPPER (cosh, ::cosh);
-         SCALAR_MAPPER (exp, ::exp);
-         SCALAR_MAPPER (expm1, ::expm1);
-         SCALAR_MAPPER (fix, ::fix);
-         SCALAR_MAPPER (floor, gnulib::floor);
-         SCALAR_MAPPER (log, rc_log);
-         SCALAR_MAPPER (log2, rc_log2);
-         SCALAR_MAPPER (log10, rc_log10);
-         SCALAR_MAPPER (log1p, rc_log1p);
-         SCALAR_MAPPER (round, xround);
-         SCALAR_MAPPER (roundb, xroundb);
-         SCALAR_MAPPER (signum, ::signum);
-         SCALAR_MAPPER (sin, ::sin);
-         SCALAR_MAPPER (sinh, ::sinh);
-         SCALAR_MAPPER (sqrt, rc_sqrt);
-         SCALAR_MAPPER (tan, ::tan);
-         SCALAR_MAPPER (tanh, ::tanh);
-         SCALAR_MAPPER (finite, xfinite);
-         SCALAR_MAPPER (isinf, xisinf);
-         SCALAR_MAPPER (isna, octave_is_NA);
-         SCALAR_MAPPER (isnan, xisnan);
-         SCALAR_MAPPER (xsignbit, xsignbit);
-      */
     default:
       if (umap >= umap_xisalnum && umap <= umap_xtoupper)
         {