Skip to content

Commit

Permalink
Merge pull request #826 from RcppCore/feature/Rmath_header_cleanup
Browse files Browse the repository at this point in the history 
comment-out R::pythag
  • Loading branch information
@eddelbuettel
eddelbuettel committed Mar 2, 2018
2 parents fc8ebec + 0ecf8df commit 06b1f62
Show file tree
Hide file tree
Showing 5 changed files with 133 additions and 129 deletions.
13 changes: 12 additions & 1 deletion ChangeLog
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,19 @@
2018-03-01 Dirk Eddelbuettel <edd@debian.org>

* 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 <edd@debian.org>

* 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 <kevinushey@gmail.com>

* src/api.cpp: Always set / put RNG state when calling Rcpp function


2018-02-25 Dirk Eddelbuettel <edd@debian.org>

* vignettes/Rcpp.bib: Updated
Expand Down
3 changes: 3 additions & 0 deletions inst/NEWS.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +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; 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
Expand Down
3 changes: 2 additions & 1 deletion inst/include/Rcpp/Rmath.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
241 changes: 115 additions & 126 deletions inst/include/Rcpp/sugar/functions/complex.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.
//
Expand All @@ -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{

Expand Down Expand Up @@ -60,89 +54,89 @@ 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)
{
Rcomplex r ;
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);
Expand All @@ -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)
{
Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -232,20 +226,15 @@ inline Rcomplex complex__tanh(Rcomplex z)
return r ;
}



} // internal

#define RCPP_SUGAR_COMPLEX(__NAME__,__OUT__) \
template <bool NA, typename T> \
inline sugar::SugarComplex<NA,__OUT__,T, __OUT__ (*)(Rcomplex) > \
__NAME__( \
const VectorBase<CPLXSXP,NA,T>& t \
){ \
return sugar::SugarComplex<NA,__OUT__,T, __OUT__ (*)(Rcomplex) >( \
internal::complex__##__NAME__, t \
) ; \
}
#define RCPP_SUGAR_COMPLEX(__NAME__,__OUT__) \
template <bool NA, typename T> \
inline sugar::SugarComplex<NA,__OUT__,T, __OUT__ (*)(Rcomplex) > \
__NAME__(const VectorBase<CPLXSXP,NA,T>& t) { \
return sugar::SugarComplex<NA,__OUT__,T, __OUT__ (*)(Rcomplex) >( \
internal::complex__##__NAME__, t); \
}

RCPP_SUGAR_COMPLEX( Re, double )
RCPP_SUGAR_COMPLEX( Im, double )
Expand Down
2 changes: 1 addition & 1 deletion inst/include/Rcpp/sugar/undoRmath.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -107,7 +107,7 @@
#undef pt
#undef ptukey
#undef punif
#undef pythag
/* #undef pythag */
#undef pweibull
#undef pwilcox
#undef qbeta
Expand Down

0 comments on commit 06b1f62

Please sign in to comment.