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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Aug 5 21:38:13 CEST 2010


Author: edd
Date: 2010-08-05 21:38:12 +0200 (Thu, 05 Aug 2010)
New Revision: 1924

Modified:
   pkg/Rcpp/inst/include/Rcpp/stats/t.h
   pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
added pt() with a unit test (note that is only pt without the ncp parameter)


Modified: pkg/Rcpp/inst/include/Rcpp/stats/t.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/t.h	2010-08-05 19:22:34 UTC (rev 1923)
+++ pkg/Rcpp/inst/include/Rcpp/stats/t.h	2010-08-05 19:38:12 UTC (rev 1924)
@@ -48,13 +48,39 @@
 		int log;
 	
 	};
+
+	template <bool NA, typename T>
+	class PT : public Rcpp::VectorBase< REALSXP, NA, PT<NA,T> >{
+	public:
+		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
 	
+		PT( const VEC_TYPE& vec_, double df_, bool lowertail_ = true, bool log_ = false ) : 
+			vec(vec_), df(df_), lowertail(lowertail_), log(log_) {}
+		
+		inline double operator[]( int i) const {
+			return ::pt( vec[i], df, lowertail, log );
+		}
+		
+		inline int size() const { return vec.size(); }
+		
+	private:
+		const VEC_TYPE& vec;
+		double df;
+		int lowertail, log;
+	
+	};
+	
 } // impl
 
 template <bool NA, typename T>
 inline impl::DT<NA,T> dt( const Rcpp::VectorBase<REALSXP,NA,T>& x, double df, bool log = false ) {
 	return impl::DT<NA,T>( x, df, log ); 
 }
+
+template <bool NA, typename T>
+inline impl::PT<NA,T> pt( const Rcpp::VectorBase<REALSXP,NA,T>& x, double df, bool lowertail = true, bool log = false ) {
+	return impl::PT<NA,T>( x, df, lowertail, log ); 
+}
 	
 }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R	2010-08-05 19:22:34 UTC (rev 1923)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R	2010-08-05 19:38:12 UTC (rev 1924)
@@ -61,6 +61,16 @@
 						_["true"]  = stats::dt( xx, 5, true )
 						) ;
 				'
+			),
+			"runit_pt" = list(
+				signature( x = "numeric" ),
+				'
+					NumericVector xx(x) ;
+					return List::create(
+						_["false"] = stats::pt( xx, 5, true),
+						_["true"]  = stats::pt( xx, 5, true, true  )
+						) ;
+				'
 			)
 
 
@@ -104,3 +114,11 @@
                 msg = "stats.dt" )
 }
 
+test.stats.pt <- function( ) {
+	fx <- .rcpp.stats$runit_pt
+    v <- seq(0.0, 1.0, by=0.1)
+    checkEquals(fx(v),
+                list( false = pt(v, 5), true = pt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
+                msg = "stats.pt" )
+}
+



More information about the Rcpp-commits mailing list