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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Sep 3 18:13:15 CEST 2012


Author: edd
Date: 2012-09-03 18:13:14 +0200 (Mon, 03 Sep 2012)
New Revision: 3764

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/DESCRIPTION
   pkg/Rcpp/inst/NEWS
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/math.h
   pkg/Rcpp/inst/unitTests/runit.sugar.R
Log:
three new sugar function trunc, signif, round as well as unit tests


Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2012-09-02 16:59:35 UTC (rev 3763)
+++ pkg/Rcpp/ChangeLog	2012-09-03 16:13:14 UTC (rev 3764)
@@ -1,3 +1,9 @@
+2012-09-03  Dirk Eddelbuettel  <edd at debian.org>
+
+	* inst/include/Rcpp/sugar/functions/math.h: Added new sugar
+	function trunc(), round() and signif()
+	* inst/unitTests/runit.sugar.R: Added unit tests for these
+
 2012-09-01  Dirk Eddelbuettel  <edd at debian.org>
 
 	* inst/doc/Makefile: The 'all' target is now empty to prevent

Modified: pkg/Rcpp/DESCRIPTION
===================================================================
--- pkg/Rcpp/DESCRIPTION	2012-09-02 16:59:35 UTC (rev 3763)
+++ pkg/Rcpp/DESCRIPTION	2012-09-03 16:13:14 UTC (rev 3764)
@@ -1,6 +1,6 @@
 Package: Rcpp
 Title: Seamless R and C++ Integration
-Version: 0.9.13.2
+Version: 0.9.13.3
 Date: $Date$
 Author: Dirk Eddelbuettel and Romain Francois, with contributions 
  by Douglas Bates and John Chambers

Modified: pkg/Rcpp/inst/NEWS
===================================================================
--- pkg/Rcpp/inst/NEWS	2012-09-02 16:59:35 UTC (rev 3763)
+++ pkg/Rcpp/inst/NEWS	2012-09-03 16:13:14 UTC (rev 3764)
@@ -1,5 +1,8 @@
 0.9.14  2012-xx-yy
 
+    o   Added new Rcpp sugar functions trunc(), round() and signif(), as well
+        as unit tests for them
+
     o   Be more conservative about where we support clang++ and the inclusion
         of exception_defines.h and prevent this from being attempted on OS X
         where it failed for clang 3.1

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/math.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/math.h	2012-09-02 16:59:35 UTC (rev 3763)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/math.h	2012-09-03 16:13:14 UTC (rev 3764)
@@ -51,20 +51,13 @@
 VECTORIZED_MATH_1(log1p      , ::log1p          )
 
 namespace Rcpp{
-namespace internal{
-
-extern "C" inline double factorial( double x ){
-    return ::Rf_gammafn( x + 1.0 ) ;
+    namespace internal{
+        extern "C" inline double factorial( double x ){ return ::Rf_gammafn( x + 1.0 ) ; }
+        extern "C" inline double lfactorial( double x ){ return ::Rf_lgammafn( x + 1.0 ) ; }
+    }
 }
-extern "C" inline double lfactorial( double x ){
-    return ::Rf_lgammafn( x + 1.0 ) ;
-}
-
-}
-}
 VECTORIZED_MATH_1(factorial  , ::Rcpp::internal::factorial   )
 VECTORIZED_MATH_1(lfactorial , ::Rcpp::internal::lfactorial  )
- 
 
 SUGAR_BLOCK_2(choose    , ::Rf_choose   )
 SUGAR_BLOCK_2(lchoose   , ::Rf_lchoose  )
@@ -72,4 +65,8 @@
 SUGAR_BLOCK_2(lbeta     , ::Rf_lbeta    )
 SUGAR_BLOCK_2(psigamma  , ::Rf_psigamma )
 
+VECTORIZED_MATH_1(trunc, ::Rf_ftrunc) 		// truncates to zero (cf Writing R Extension, 6.7.3 Numerical Utilities)
+SUGAR_BLOCK_2(round,     ::Rf_fround)           // rounds 'x' to 'digits' decimals digits (used by R's round())
+SUGAR_BLOCK_2(signif,    ::Rf_fprec)            // rounds 'x' to 'digits' significant digits (used by R's signif())
+
 #endif

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.R	2012-09-02 16:59:35 UTC (rev 3763)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.R	2012-09-03 16:13:14 UTC (rev 3764)
@@ -1,4 +1,5 @@
 #!/usr/bin/r -t
+#                     -*- mode: R; ess-indent-level: 4; indent-tabs-mode: nil; -*-
 #
 # Copyright (C) 2010 - 2012  Dirk Eddelbuettel and Romain Francois
 #
@@ -18,7 +19,7 @@
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 definitions <- function(){
-list(
+    list(
 			"runit_abs" = list(
 				signature( x = "numeric", y = "numeric" ),
 				'
@@ -676,7 +677,32 @@
 			         NumericVector res= diff(x) ;
 			         return res ;
 			    '
+			),
+			"runit_trunc" = list(
+                        	signature( x = "numeric", y = "integer" ),
+                        	'
+					NumericVector xx(x) ;
+					IntegerVector yy(y) ;
+					return List::create(trunc(xx), trunc(yy)) ;
+				'
+			),
+			"runit_round" = list(
+                        	signature( x = "numeric", ds = "integer" ),
+                        	'
+					NumericVector xx(x);
+					int d = as<int>(ds);
+					return wrap(round(xx, d));
+				'
+			),
+			"runit_signif" = list(
+                        	signature( x = "numeric", ds = "integer" ),
+                        	'
+					NumericVector xx(x);
+					int d = as<int>(ds);
+					return wrap(signif(xx, d));
+				'
 			)
+
 		)
 
 }
@@ -1327,3 +1353,26 @@
     checkEquals( fx(x), c(NA, 1.0, NA, NA, 2.0, NA) )
 }
 
+# additions 03 Sep 2012
+test.sugar.trunc <- function() {
+    fx <- .rcpp.sugar$runit_trunc
+    x <- seq(-5,5) + 0.5
+    y <- seq(-5L, 5L)
+    checkEquals(fx(x, y), list(trunc(x), trunc(y)))
+}
+test.sugar.round <- function() {
+    fx <- .rcpp.sugar$runit_round
+    x <- seq(-5,5) + 0.25
+    checkEquals( fx(x, 0), round(x, 0) )
+    checkEquals( fx(x, 1), round(x, 1) )
+    checkEquals( fx(x, 2), round(x, 2) )
+    checkEquals( fx(x, 3), round(x, 3) )
+}
+test.sugar.signif <- function() {
+    fx <- .rcpp.sugar$runit_signif
+    x <- seq(-5,5) + 0.25
+    checkEquals( fx(x, 0), signif(x, 0) )
+    checkEquals( fx(x, 1), signif(x, 1) )
+    checkEquals( fx(x, 2), signif(x, 2) )
+    checkEquals( fx(x, 3), signif(x, 3) )
+}



More information about the Rcpp-commits mailing list