[Rcpp-commits] r1920 - in pkg/Rcpp/inst: include/Rcpp/stats unitTests

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

Author: edd
Date: 2010-08-05 17:47:29 +0200 (Thu, 05 Aug 2010)
New Revision: 1920

Added:
   pkg/Rcpp/inst/include/Rcpp/stats/norm.h
Modified:
   pkg/Rcpp/inst/include/Rcpp/stats/stats.h
   pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
trying a hand at dnorm and the associated unit test but not quite there yet


Added: pkg/Rcpp/inst/include/Rcpp/stats/norm.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/norm.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/stats/norm.h	2010-08-05 15:47:29 UTC (rev 1920)
@@ -0,0 +1,85 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*-
+//
+// norm.h: Rcpp R/C++ interface class library -- normal distribution
+//
+// Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp__stats__norm_h
+#define Rcpp__stats__norm_h
+
+namespace Rcpp {
+
+namespace stats {
+
+namespace impl {
+
+	template <bool NA, typename T>
+	class DNorm : public Rcpp::VectorBase< REALSXP, NA, DNorm<NA,T> >{
+	public:
+		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+	
+		DNorm( const VEC_TYPE& vec_, double mu_, double sigma_, bool log_ = false ) : 
+			vec(vec_), mu(mu_), sigma(sigma_), log(log_) {}
+		
+		inline double operator[]( int i) const {
+			int x = vec[i] ;
+			return Rcpp::traits::is_na<REALSXP>( x ) ? NA_REAL : ::dnorm( x, mu, sigma, log );
+		}
+		
+		inline int size() const { return vec.size(); }
+		
+	private:
+		const VEC_TYPE& vec;
+		double mu, sigma;
+		int log;
+	
+};
+
+template <typename T>
+class DNorm<false,T> : public Rcpp::VectorBase< REALSXP, false, DNorm<false,T> >{
+public:
+	typedef typename Rcpp::VectorBase<REALSXP,false,T> VEC_TYPE;
+	
+	DNorm( const VEC_TYPE& vec_, double mu_, double sigma_, bool log_ = false ) : 
+		vec(vec_), mu(mu_), sigma(sigma_), log(log_) {}
+	
+	inline double operator[]( int i) const {
+		return ::dnorm( vec[i], mu, sigma, log );
+	}
+	
+	inline int size() const { return vec.size(); }
+	
+private:
+	const VEC_TYPE& vec;
+	double mu, sigma;
+	int log;
+	
+} ;
+
+
+} // impl
+
+template <bool NA, typename T>
+inline impl::DNorm<NA,T> dnorm( const Rcpp::VectorBase<REALSXP,NA,T>& x, double mu, double sigma, bool log = false ) {
+	return impl::DNorm<NA,T>( x, mu, sigma, log ); 
+}
+	
+}
+}
+
+#endif


Property changes on: pkg/Rcpp/inst/include/Rcpp/stats/norm.h
___________________________________________________________________
Added: svn:eol-style
   + native

Modified: pkg/Rcpp/inst/include/Rcpp/stats/stats.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/stats.h	2010-08-05 15:40:15 UTC (rev 1919)
+++ pkg/Rcpp/inst/include/Rcpp/stats/stats.h	2010-08-05 15:47:29 UTC (rev 1920)
@@ -24,5 +24,6 @@
 
 #include <Rcpp/stats/binom.h>
 #include <Rcpp/stats/pois.h>
+#include <Rcpp/stats/norm.h>
 
 #endif

Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R	2010-08-05 15:40:15 UTC (rev 1919)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R	2010-08-05 15:47:29 UTC (rev 1920)
@@ -41,7 +41,18 @@
 						_["true"]  = stats::dpois( xx, .5 , true )
 						) ;
 				'
+			),
+			"runit_dnorm" = list(
+				signature( x = "numeric" ),
+				'
+					NumericVector xx(x) ;
+					return List::create(
+						_["false"] = stats::dnorm( xx, 0.0, 1.0 ),
+						_["true"]  = stats::dnorm( xx, 0.0, 1.0, true )
+						) ;
+				'
 			)
+
 		)
 
 		signatures <- lapply( f, "[[", 1L )
@@ -66,3 +77,11 @@
                 msg = "stats.dpois" )
 }
 
+test.stats.dnorm <- function( ) {
+	fx <- .rcpp.stats$runit_dnorm
+    v <- seq(0.0, 1.0, by=0.1)
+	checkEquals(fx(v),
+                list( false = dnorm(v, 0.0, 1.0), true = dnorm(v, 0.0, 1.0, TRUE ) ),
+                msg = "stats.dnorm" )
+}
+