From f4e8a60e45713ffc46edf2580a10eba30242de59 Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Wed, 28 Feb 2018 11:18:44 -0600 Subject: [PATCH 1/2] comment-out R::pythag --- ChangeLog | 6 +++++- inst/NEWS.Rd | 2 ++ inst/include/Rcpp/Rmath.h | 3 ++- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 21f25a38f..2bcf093af 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,12 @@ +2018-02-28 Dirk Eddelbuettel + + * inst/include/Rcpp/Rmath.h (R): Rf_pythag has been remove in R 2.14.0 + so comment-out the R::pythag wrapper (per request of Brian Ripley) + 2018-02-26 Kevin Ushey * src/api.cpp: Always set / put RNG state when calling Rcpp function - 2018-02-25 Dirk Eddelbuettel * vignettes/Rcpp.bib: Updated diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index ae0225a7a..3ad81f3d0 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -10,6 +10,8 @@ \item Rcpp now sets and puts the RNG state upon each entry to an Rcpp function, ensuring that nested invocations of Rcpp functions manage the RNG state as expected + \item The \code{R::pythag} wrapper has been commented out as underlying + function has been gone from R since release 2.14.0. } \itemize{ \item The \code{long long} type can now be used on 64-bit Windows (Kevin diff --git a/inst/include/Rcpp/Rmath.h b/inst/include/Rcpp/Rmath.h index e8b1bf1e9..757b88582 100644 --- a/inst/include/Rcpp/Rmath.h +++ b/inst/include/Rcpp/Rmath.h @@ -219,7 +219,8 @@ namespace R { #ifndef HAVE_HYPOT inline double hypot(double a, double b) { return ::Rf_hypot(a, b); } #endif - inline double pythag(double a, double b) { return ::Rf_pythag(a, b); } + /* Gone since R 2.14.0 according to Brian Ripley and is now comment out per his request */ + /* inline double pythag(double a, double b) { return ::Rf_pythag(a, b); } */ #ifndef HAVE_EXPM1 inline double expm1(double x); /* = exp(x)-1 {care for small x} */ { return ::Rf_expm1(x); } #endif From 0ecf8df332522b9fd80a9daaf4ea6e0f9b3bec84 Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Thu, 1 Mar 2018 15:29:32 -0600 Subject: [PATCH 2/2] more pythag related changes: also undo use of RCPP_HYPOT --- ChangeLog | 7 + inst/NEWS.Rd | 5 +- inst/include/Rcpp/sugar/functions/complex.h | 241 ++++++++++---------- inst/include/Rcpp/sugar/undoRmath.h | 2 +- 4 files changed, 126 insertions(+), 129 deletions(-) diff --git a/ChangeLog b/ChangeLog index 2bcf093af..86da0ca4e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2018-03-01 Dirk Eddelbuettel + + * inst/include/Rcpp/sugar/functions/complex.h (Rcpp): Remove RCPP_HYPOT + macro and use ::hypot() throught as it is provided with C99 + + * inst/include/Rcpp/sugar/undoRmath.h: Also uncomment pythag here + 2018-02-28 Dirk Eddelbuettel * inst/include/Rcpp/Rmath.h (R): Rf_pythag has been remove in R 2.14.0 diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index 3ad81f3d0..1628f045a 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -10,8 +10,9 @@ \item Rcpp now sets and puts the RNG state upon each entry to an Rcpp function, ensuring that nested invocations of Rcpp functions manage the RNG state as expected - \item The \code{R::pythag} wrapper has been commented out as underlying - function has been gone from R since release 2.14.0. + \item The \code{R::pythag} wrapper has been commented out; the underlying + function has been gone from R since 2.14.0, and \code{::hypot()} (part of + C99) is now used unconditionally for complex numbers. } \itemize{ \item The \code{long long} type can now be used on 64-bit Windows (Kevin diff --git a/inst/include/Rcpp/sugar/functions/complex.h b/inst/include/Rcpp/sugar/functions/complex.h index f675e7256..800c856fb 100644 --- a/inst/include/Rcpp/sugar/functions/complex.h +++ b/inst/include/Rcpp/sugar/functions/complex.h @@ -2,7 +2,7 @@ // // complex.h: Rcpp R/C++ interface class library -- complex // -// Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois +// Copyright (C) 2010 - 2018 Dirk Eddelbuettel and Romain Francois // // This file is part of Rcpp. // @@ -22,12 +22,6 @@ #ifndef Rcpp__sugar__complex_h #define Rcpp__sugar__complex_h -#ifdef HAVE_HYPOT -# define RCPP_HYPOT ::hypot -#else -# define RCPP_HYPOT ::Rf_pythag -#endif - namespace Rcpp{ namespace sugar{ @@ -60,80 +54,80 @@ class SugarComplex : public Rcpp::VectorBase< namespace internal{ inline double complex__Re( Rcomplex x){ return x.r ; } - inline double complex__Im( Rcomplex x){ return x.i ; } - inline double complex__Mod( Rcomplex x){ return ::sqrt( x.i * x.i + x.r * x.r) ; } - inline Rcomplex complex__Conj( Rcomplex x){ - Rcomplex y ; - y.r = x.r; - y.i = -x.i ; - return y ; - } - inline double complex__Arg( Rcomplex x ){ return ::atan2(x.i, x.r); } - // TODO: this does not use HAVE_C99_COMPLEX as in R, perhaps it should - inline Rcomplex complex__exp( Rcomplex x){ - Rcomplex y ; - double expx = ::exp(x.r); - y.r = expx * ::cos(x.i); - y.i = expx * ::sin(x.i); - return y ; - } - inline Rcomplex complex__log( Rcomplex x){ - Rcomplex y ; - y.i = ::atan2(x.i, x.r); - y.r = ::log( RCPP_HYPOT( x.r, x.i ) ); - return y ; - } - inline Rcomplex complex__sqrt(Rcomplex z){ - Rcomplex r ; - double mag; +inline double complex__Im( Rcomplex x){ return x.i ; } +inline double complex__Mod( Rcomplex x){ return ::sqrt( x.i * x.i + x.r * x.r) ; } +inline Rcomplex complex__Conj( Rcomplex x){ + Rcomplex y ; + y.r = x.r; + y.i = -x.i ; + return y ; +} +inline double complex__Arg( Rcomplex x ){ return ::atan2(x.i, x.r); } +// TODO: this does not use HAVE_C99_COMPLEX as in R, perhaps it should +inline Rcomplex complex__exp( Rcomplex x){ + Rcomplex y ; + double expx = ::exp(x.r); + y.r = expx * ::cos(x.i); + y.i = expx * ::sin(x.i); + return y ; +} +inline Rcomplex complex__log( Rcomplex x){ + Rcomplex y ; + y.i = ::atan2(x.i, x.r); + y.r = ::log(::hypot(x.r, x.i)); + return y ; +} +inline Rcomplex complex__sqrt(Rcomplex z){ + Rcomplex r ; + double mag; - if( (mag = RCPP_HYPOT(z.r, z.i)) == 0.0) - r.r = r.i = 0.0; - else if(z.r > 0) { - r.r = ::sqrt(0.5 * (mag + z.r) ); - r.i = z.i / r.r / 2; - } - else { - r.i = ::sqrt(0.5 * (mag - z.r) ); - if(z.i < 0) - r.i = - r.i; - r.r = z.i / r.i / 2; - } - return r ; - } - inline Rcomplex complex__cos(Rcomplex z){ - Rcomplex r ; - r.r = ::cos(z.r) * ::cosh(z.i); - r.i = - ::sin(z.r) * ::sinh(z.i); - return r ; - } - inline Rcomplex complex__cosh(Rcomplex z){ - Rcomplex r; - r.r = ::cos(-z.i) * ::cosh( z.r); - r.i = - ::sin(-z.i) * ::sinh(z.r); - return r ; - } - inline Rcomplex complex__sin(Rcomplex z){ - Rcomplex r ; - r.r = ::sin(z.r) * ::cosh(z.i); - r.i = ::cos(z.r) * ::sinh(z.i); - return r; - } - inline Rcomplex complex__tan(Rcomplex z){ - Rcomplex r ; - double x2, y2, den; - x2 = 2.0 * z.r; - y2 = 2.0 * z.i; - den = ::cos(x2) + ::cosh(y2); - r.r = ::sin(x2)/den; - /* any threshold between -log(DBL_EPSILON) - and log(DBL_XMAX) will do*/ - if (ISNAN(y2) || ::fabs(y2) < 50.0) - r.i = ::sinh(y2)/den; - else - r.i = (y2 <0 ? -1.0 : 1.0); - return r ; - } + if( (mag = ::hypot(z.r, z.i)) == 0.0) + r.r = r.i = 0.0; + else if(z.r > 0) { + r.r = ::sqrt(0.5 * (mag + z.r) ); + r.i = z.i / r.r / 2; + } + else { + r.i = ::sqrt(0.5 * (mag - z.r) ); + if(z.i < 0) + r.i = - r.i; + r.r = z.i / r.i / 2; + } + return r ; +} +inline Rcomplex complex__cos(Rcomplex z){ + Rcomplex r ; + r.r = ::cos(z.r) * ::cosh(z.i); + r.i = - ::sin(z.r) * ::sinh(z.i); + return r ; +} +inline Rcomplex complex__cosh(Rcomplex z){ + Rcomplex r; + r.r = ::cos(-z.i) * ::cosh( z.r); + r.i = - ::sin(-z.i) * ::sinh(z.r); + return r ; +} +inline Rcomplex complex__sin(Rcomplex z){ + Rcomplex r ; + r.r = ::sin(z.r) * ::cosh(z.i); + r.i = ::cos(z.r) * ::sinh(z.i); + return r; +} +inline Rcomplex complex__tan(Rcomplex z){ + Rcomplex r ; + double x2, y2, den; + x2 = 2.0 * z.r; + y2 = 2.0 * z.i; + den = ::cos(x2) + ::cosh(y2); + r.r = ::sin(x2)/den; + /* any threshold between -log(DBL_EPSILON) + and log(DBL_XMAX) will do*/ + if (ISNAN(y2) || ::fabs(y2) < 50.0) + r.i = ::sinh(y2)/den; + else + r.i = (y2 <0 ? -1.0 : 1.0); + return r ; +} inline Rcomplex complex__asin(Rcomplex z) { @@ -141,8 +135,8 @@ inline Rcomplex complex__asin(Rcomplex z) double alpha, bet, t1, t2, x, y; x = z.r; y = z.i; - t1 = 0.5 * RCPP_HYPOT(x + 1, y); - t2 = 0.5 * RCPP_HYPOT(x - 1, y); + t1 = 0.5 * ::hypot(x + 1, y); + t2 = 0.5 * ::hypot(x - 1, y); alpha = t1 + t2; bet = t1 - t2; r.r = ::asin(bet); @@ -159,13 +153,13 @@ inline Rcomplex complex__acos(Rcomplex z) return r ; } - /* Complex Arctangent Function */ - /* Equation (4.4.39) Abramowitz and Stegun */ - /* with additional terms to force the branch cuts */ - /* to agree with figure 4.4, p79. Continuity */ - /* on the branch cuts (pure imaginary axis; x==0, |y|>1) */ - /* is standard: z_asin() is continuous from the right */ - /* if y >= 1, and continuous from the left if y <= -1. */ +/* Complex Arctangent Function */ +/* Equation (4.4.39) Abramowitz and Stegun */ +/* with additional terms to force the branch cuts */ +/* to agree with figure 4.4, p79. Continuity */ +/* on the branch cuts (pure imaginary axis; x==0, |y|>1) */ +/* is standard: z_asin() is continuous from the right */ +/* if y >= 1, and continuous from the left if y <= -1. */ inline Rcomplex complex__atan(Rcomplex z) { @@ -175,7 +169,7 @@ inline Rcomplex complex__atan(Rcomplex z) y = z.i; r.r = 0.5 * ::atan(2 * x / ( 1 - x * x - y * y)); r.i = 0.25 * ::log((x * x + (y + 1) * (y + 1)) / - (x * x + (y - 1) * (y - 1))); + (x * x + (y - 1) * (y - 1))); if(x*x + y*y > 1) { r.r += M_PI_2; if(x < 0 || (x == 0 && y < 0)) r.r -= M_PI; @@ -184,32 +178,32 @@ inline Rcomplex complex__atan(Rcomplex z) } - inline Rcomplex complex__acosh(Rcomplex z){ - Rcomplex r, a = complex__acos(z); - r.r = -a.i; - r.i = a.r; - return r ; - } +inline Rcomplex complex__acosh(Rcomplex z){ + Rcomplex r, a = complex__acos(z); + r.r = -a.i; + r.i = a.r; + return r ; +} - inline Rcomplex complex__asinh(Rcomplex z){ - Rcomplex r, b; - b.r = -z.i; - b.i = z.r; - Rcomplex a = complex__asin(b); - r.r = a.i; - r.i = -a.r; - return r ; - } +inline Rcomplex complex__asinh(Rcomplex z){ + Rcomplex r, b; + b.r = -z.i; + b.i = z.r; + Rcomplex a = complex__asin(b); + r.r = a.i; + r.i = -a.r; + return r ; +} - inline Rcomplex complex__atanh(Rcomplex z){ - Rcomplex r, b; - b.r = -z.i; - b.i = z.r; - Rcomplex a = complex__atan(b); - r.r = a.i; - r.i = -a.r; - return r ; - } +inline Rcomplex complex__atanh(Rcomplex z){ + Rcomplex r, b; + b.r = -z.i; + b.i = z.r; + Rcomplex a = complex__atan(b); + r.r = a.i; + r.i = -a.r; + return r ; +} inline Rcomplex complex__sinh(Rcomplex z) { Rcomplex r, b; @@ -232,20 +226,15 @@ inline Rcomplex complex__tanh(Rcomplex z) return r ; } - - } // internal -#define RCPP_SUGAR_COMPLEX(__NAME__,__OUT__) \ - template \ - inline sugar::SugarComplex \ - __NAME__( \ - const VectorBase& t \ - ){ \ - return sugar::SugarComplex( \ - internal::complex__##__NAME__, t \ - ) ; \ - } +#define RCPP_SUGAR_COMPLEX(__NAME__,__OUT__) \ + template \ + inline sugar::SugarComplex \ + __NAME__(const VectorBase& t) { \ + return sugar::SugarComplex( \ + internal::complex__##__NAME__, t); \ + } RCPP_SUGAR_COMPLEX( Re, double ) RCPP_SUGAR_COMPLEX( Im, double ) diff --git a/inst/include/Rcpp/sugar/undoRmath.h b/inst/include/Rcpp/sugar/undoRmath.h index fdf17b2b1..c718b724a 100644 --- a/inst/include/Rcpp/sugar/undoRmath.h +++ b/inst/include/Rcpp/sugar/undoRmath.h @@ -107,7 +107,7 @@ #undef pt #undef ptukey #undef punif -#undef pythag +/* #undef pythag */ #undef pweibull #undef pwilcox #undef qbeta