[Rcpp-commits] r1998 - in pkg/Rcpp/inst: . include/Rcpp/sugar/functions unitTests

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-08-13 11:48:25 +0200 (Fri, 13 Aug 2010)
New Revision: 1998

Modified:
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/complex.h
   pkg/Rcpp/inst/unitTests/runit.sugar.R
Log:
new functions for complex : sqrt, cos, cosh (still more to come)

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-08-13 09:30:04 UTC (rev 1997)
+++ pkg/Rcpp/inst/ChangeLog	2010-08-13 09:48:25 UTC (rev 1998)
@@ -4,7 +4,7 @@
 	Re, Im, Conj, Mod
 	
 	* inst/include/Rcpp/sugar/complex.h: new sugar functions operating on 
-	complex expressions: exp, log
+	complex expressions: exp, log, sqrt, cos, cosh
 	
 	* inst/unitTests/runit.sugar.R: added regression test for complex functions
 	which did not handle NA properly before

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/complex.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/complex.h	2010-08-13 09:30:04 UTC (rev 1997)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/complex.h	2010-08-13 09:48:25 UTC (rev 1998)
@@ -1,6 +1,6 @@
 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
 //
-// Mod.h: Rcpp R/C++ interface class library -- Mod
+// complex.h: Rcpp R/C++ interface class library -- complex
 //
 // Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
 //
@@ -82,6 +82,38 @@
 		y.r = ::log( RCPP_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 ;
+	}
+	
+
 } // internal
 
 #define RCPP_SUGAR_COMPLEX(__NAME__,__OUT__)                                \
@@ -101,6 +133,9 @@
 RCPP_SUGAR_COMPLEX( Conj, Rcomplex )
 RCPP_SUGAR_COMPLEX( exp, Rcomplex )
 RCPP_SUGAR_COMPLEX( log, Rcomplex )
+RCPP_SUGAR_COMPLEX( sqrt, Rcomplex )
+RCPP_SUGAR_COMPLEX( cos, Rcomplex ) 
+RCPP_SUGAR_COMPLEX( cosh, Rcomplex )
 
 #undef RCPP_SUGAR_COMPLEX	 
 	

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.R	2010-08-13 09:30:04 UTC (rev 1997)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.R	2010-08-13 09:48:25 UTC (rev 1998)
@@ -473,12 +473,15 @@
 				'
 					ComplexVector cx( x );
 					return List::create( 
-						_["Re"] = Re( cx ), 
-						_["Im"] = Im( cx ), 
+						_["Re"]   = Re( cx ), 
+						_["Im"]   = Im( cx ), 
 						_["Conj"] = Conj( cx ), 
-						_["Mod"] = Mod( cx ), 
-						_["exp"] = exp( cx ), 
-						_["log"] = log( cx )
+						_["Mod"]  = Mod( cx ), 
+						_["exp"]  = exp( cx ), 
+						_["log"]  = log( cx ), 
+						_["sqrt"] = sqrt( cx ), 
+						_["cos"]  = cos( cx ), 
+						_["cosh"] = cosh( cx )
 						) ;
 				'
 			), 
@@ -1070,12 +1073,15 @@
 	x <- c( rnorm(10), NA ) + 1i*c( rnorm(10), NA )
 	fx <- .rcpp.sugar$runit_complex
 	checkEquals( fx(x), list( 
-		Re = Re( x ), 
-		Im = Im( x ), 
+		Re   = Re(x), 
+		Im   = Im(x), 
 		Conj = Conj(x), 
-		Mod = Mod(x), 
-		exp = exp(x), 
-		log = log(x)
+		Mod  = Mod(x), 
+		exp  = exp(x), 
+		log  = log(x), 
+		sqrt = sqrt(x), 
+		cos  = cos(x), 
+		cosh = cosh(x)
 		)
 	)
 }