[Rcpp-commits] r2005 - in pkg/Rcpp/inst/include: . Rcpp/stats Rcpp/stats/dpq

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Aug 15 09:48:49 CEST 2010


Author: romain
Date: 2010-08-15 09:48:48 +0200 (Sun, 15 Aug 2010)
New Revision: 2005

Added:
   pkg/Rcpp/inst/include/Rcpp/stats/dpq/macros.h
Modified:
   pkg/Rcpp/inst/include/Rcpp.h
   pkg/Rcpp/inst/include/Rcpp/stats/beta.h
   pkg/Rcpp/inst/include/Rcpp/stats/binom.h
   pkg/Rcpp/inst/include/Rcpp/stats/cauchy.h
   pkg/Rcpp/inst/include/Rcpp/stats/chisq.h
   pkg/Rcpp/inst/include/Rcpp/stats/dpq/dpq.h
   pkg/Rcpp/inst/include/Rcpp/stats/exp.h
   pkg/Rcpp/inst/include/Rcpp/stats/f.h
   pkg/Rcpp/inst/include/Rcpp/stats/gamma.h
   pkg/Rcpp/inst/include/Rcpp/stats/geom.h
   pkg/Rcpp/inst/include/Rcpp/stats/hyper.h
   pkg/Rcpp/inst/include/Rcpp/stats/lnorm.h
   pkg/Rcpp/inst/include/Rcpp/stats/stats.h
Log:
some more use of RCPP_DPQ macros

Modified: pkg/Rcpp/inst/include/Rcpp/stats/beta.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/beta.h	2010-08-14 17:46:02 UTC (rev 2004)
+++ pkg/Rcpp/inst/include/Rcpp/stats/beta.h	2010-08-15 07:48:48 UTC (rev 2005)
@@ -22,6 +22,6 @@
 #ifndef Rcpp__stats__beta_h
 #define Rcpp__stats__beta_h
 
-RCPP_DPQ_2(beta,::dbeta,::pbeta,::qbeta)
+RCPP_DPQ_2(beta,::Rf_dbeta,::Rf_pbeta,::Rf_qbeta)
 
 #endif

Modified: pkg/Rcpp/inst/include/Rcpp/stats/binom.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/binom.h	2010-08-14 17:46:02 UTC (rev 2004)
+++ pkg/Rcpp/inst/include/Rcpp/stats/binom.h	2010-08-15 07:48:48 UTC (rev 2005)
@@ -22,93 +22,6 @@
 #ifndef Rcpp__stats__binom_h
 #define Rcpp__stats__binom_h
 
-namespace Rcpp{
-namespace stats{
+RCPP_DPQ_2(binom,::dbinom,::pbinom,::qbinom)
 
-
-template <bool NA, typename T>
-class DBinom : public Rcpp::VectorBase< REALSXP, NA, DBinom<NA,T> >{
-public:
-	typedef typename Rcpp::VectorBase<INTSXP,NA,T> VEC_TYPE ;
-	
-	DBinom( const VEC_TYPE& vec_, int n_, double prob_, bool log_ = false ) : 
-		vec(vec_), n(n_), prob(prob_), log(log_) {}
-	
-	inline double operator[]( int i) const {
-	    return ::dbinom( vec[i], (double) n, prob, log ) ;
-	}
-	
-	inline int size() const { return vec.size(); }
-	
-private:
-	const VEC_TYPE& vec ;
-	int n ;
-	double prob ;
-	int log ;
-	
-} ;
-
-template <bool NA, typename T>
-class PBinom : public Rcpp::VectorBase< REALSXP, NA, PBinom<NA,T> >{
-public:
-    typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE ;
-	
-    PBinom( const VEC_TYPE& vec_, int n_, double prob_, bool lower_tail = true, bool log_ = false ) : 
-	vec(vec_), n(n_), prob(prob_), lower(lower_tail), log(log_) {}
-	
-    inline double operator[]( int i) const {
-	return ::pbinom( vec[i], (double) n, prob, lower, log ) ;
-    }
-	
-    inline int size() const { return vec.size(); }
-	
-private:
-    const VEC_TYPE& vec ;
-    int n ;
-    double prob ;
-    int lower, log ;
-	
-} ;
-
-template <bool NA, typename T>
-class QBinom : public Rcpp::VectorBase< REALSXP, NA, QBinom<NA,T> >{
-public:
-    typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE ;
-	
-    QBinom( const VEC_TYPE& vec_, int n_, double prob_, bool lower_tail = true, bool log_ = false ) : 
-	vec(vec_), n(n_), prob(prob_), lower(lower_tail), log(log_) {}
-	
-	inline double operator[]( int i) const {
-	    return ::qbinom( vec[i], (double) n, prob, lower, log ) ;
-	}
-	
-	inline int size() const { return vec.size(); }
-	
-private:
-    const VEC_TYPE& vec ;
-    int n ;
-    double prob ;
-    int lower, log ;
-	
-} ;
-
-} // stats
-
-template <bool NA, typename T>
-inline stats::DBinom<NA,T> dbinom( const Rcpp::VectorBase<INTSXP,NA,T>& x, int size, double prob, bool log = false ){
-	return stats::DBinom<NA,T>( x, size, prob, log ); 
-}
-
-template <bool NA, typename T>
-inline stats::PBinom<NA,T> pbinom( const Rcpp::VectorBase<REALSXP,NA,T>& x, int size, double prob, bool lower = true, bool log = false ){
-    return stats::PBinom<NA,T>( x, size, prob, lower, log ); 
-}
-
-template <bool NA, typename T>
-inline stats::QBinom<NA,T> qbinom( const Rcpp::VectorBase<REALSXP,NA,T>& x, int size, double prob, bool lower = true, bool log = false ){
-    return stats::QBinom<NA,T>( x, size, prob, lower, log ); 
-}
-	
-}
-
 #endif

Modified: pkg/Rcpp/inst/include/Rcpp/stats/cauchy.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/cauchy.h	2010-08-14 17:46:02 UTC (rev 2004)
+++ pkg/Rcpp/inst/include/Rcpp/stats/cauchy.h	2010-08-15 07:48:48 UTC (rev 2005)
@@ -25,93 +25,38 @@
 #ifndef Rcpp__stats__cauchy_h
 #define Rcpp__stats__cauchy_h
 
-namespace Rcpp {
-namespace stats {
+namespace Rcpp{
+namespace stats{
 
+inline double dcauchy_0(double x, int give_log){
+	return ::dcauchy(x,0.0,1.0, give_log) ;
+}
+inline double dcauchy_1(double x, double location, int give_log){
+	return ::dcauchy(x,location,1.0, give_log) ;
+}
 
-	template <bool NA, typename T>
-	class DCauchy : public Rcpp::VectorBase< REALSXP, NA, DCauchy<NA,T> >{
-	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-	
-		DCauchy( const VEC_TYPE& vec_, double location_ = 0.0, double scale_ = 1.0 , bool log_ = false ) : 
-			vec(vec_), location(location_), scale(scale_) , log(log_) {}
-		
-		inline double operator[]( int i) const {
-			return ::dcauchy( vec[i], location, scale , log );
-		}
-		
-		inline int size() const { return vec.size(); }
-		
-	private:
-		const VEC_TYPE& vec;
-		double location; double scale; 
-		int log;
-	
-	};
+inline double pcauchy_0(double x, int lower_tail, int log_p){
+	return ::pcauchy(x,0.0,1.0,lower_tail, log_p) ;
+}
+inline double pcauchy_1(double x, double location, int lower_tail, int log_p){
+	return ::pcauchy(x,location,1.0,lower_tail, log_p) ;
+}
 
-	template <bool NA, typename T>
-	class PCauchy : public Rcpp::VectorBase< REALSXP, NA, PCauchy<NA,T> >{
-	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-	
-		PCauchy( const VEC_TYPE& vec_, double location_ = 0.0, double scale_ = 1.0 ,
-			   bool lower_tail = true, bool log_ = false ) : 
-			vec(vec_), location(location_), scale(scale_) , lower(lower_tail), log(log_) {}
-		
-		inline double operator[]( int i) const {
-			return ::pcauchy( vec[i], location, scale, lower, log );
-		}
-		
-		inline int size() const { return vec.size(); }
-		
-	private:
-		const VEC_TYPE& vec;
-		double location; double scale; 
-		int lower, log;
-	
-	};
+inline double qcauchy_0(double p, int lower_tail, int log_p){
+	return ::qcauchy(p, 0.0, 1.0, lower_tail, log_p ) ;
+}
+inline double qcauchy_1(double p, double location, int lower_tail, int log_p){
+	return ::qcauchy(p, location, 1.0, lower_tail, log_p ) ;
+}
 
-	template <bool NA, typename T>
-	class QCauchy : public Rcpp::VectorBase< REALSXP, NA, QCauchy<NA,T> >{
-	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-	
-		QCauchy( const VEC_TYPE& vec_, double location_ = 0.0, double scale_ = 1.0 ,
-			   bool lower_tail = true, bool log_ = false ) : 
-			vec(vec_), location(location_), scale(scale_), lower(lower_tail), log(log_) {}
-		
-		inline double operator[]( int i) const {
-			return ::qcauchy( vec[i], location, scale, lower, log );
-		}
-		
-		inline int size() const { return vec.size(); }
-		
-	private:
-		const VEC_TYPE& vec;
-		double location; double scale; 
-		int lower, log;
-	
-	};
-	
 } // stats
+} // Rcpp
 
-template <bool NA, typename T>
-inline stats::DCauchy<NA,T> dcauchy( const Rcpp::VectorBase<REALSXP,NA,T>& x, double location_ = 0.0, double scale_ = 1.0, bool log = false ) {
-	return stats::DCauchy<NA,T>( x, location_, scale_, log ); 
-}
 
-template <bool NA, typename T>
-inline stats::PCauchy<NA,T> pcauchy( const Rcpp::VectorBase<REALSXP,NA,T>& x, double location_ = 0.0, double scale_ = 1.0, bool lower = true, bool log = false ) {
-	return stats::PCauchy<NA,T>( x, location_, scale_, lower, log ); 
-}
+RCPP_DPQ_0(cauchy,Rcpp::stats::dcauchy_0,Rcpp::stats::pcauchy_0,Rcpp::stats::qcauchy_0)
+RCPP_DPQ_1(cauchy,Rcpp::stats::dcauchy_1,Rcpp::stats::pcauchy_1,Rcpp::stats::qcauchy_1)
+RCPP_DPQ_2(cauchy,::dcauchy,::pcauchy,::qcauchy)
 
-template <bool NA, typename T>
-inline stats::QCauchy<NA,T> qcauchy( const Rcpp::VectorBase<REALSXP,NA,T>& x, double location_ = 0.0, double scale_ = 1.0, bool lower = true, bool log = false ) {
-	return stats::QCauchy<NA,T>( x, location_, scale_, lower, log ); 
-}
-	
-}
 
 #endif
 

Modified: pkg/Rcpp/inst/include/Rcpp/stats/chisq.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/chisq.h	2010-08-14 17:46:02 UTC (rev 2004)
+++ pkg/Rcpp/inst/include/Rcpp/stats/chisq.h	2010-08-15 07:48:48 UTC (rev 2005)
@@ -1,8 +1,5 @@
-
 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*-
 //
-// auto generated file (from script/stats.R) 
-//
 // chisq.h: Rcpp R/C++ interface class library -- 
 //
 // Copyright (C) 2010 Douglas Bates, Dirk Eddelbuettel and Romain Francois
@@ -25,93 +22,7 @@
 #ifndef Rcpp__stats__chisq_h
 #define Rcpp__stats__chisq_h
 
-namespace Rcpp {
-namespace stats {
+RCPP_DPQ_1(chisq,::Rf_dchisq,::Rf_pchisq,::Rf_qchisq)
 
-
-	template <bool NA, typename T>
-	class DChisq : public Rcpp::VectorBase< REALSXP, NA, DChisq<NA,T> >{
-	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-	
-		DChisq( const VEC_TYPE& vec_, double df_ , bool log_ = false ) : 
-			vec(vec_), df(df_) , log(log_) {}
-		
-		inline double operator[]( int i) const {
-			return ::dchisq( vec[i], df , log );
-		}
-		
-		inline int size() const { return vec.size(); }
-		
-	private:
-		const VEC_TYPE& vec;
-		double df; 
-		int log;
-	
-	};
-
-	template <bool NA, typename T>
-	class PChisq : public Rcpp::VectorBase< REALSXP, NA, PChisq<NA,T> >{
-	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-	
-		PChisq( const VEC_TYPE& vec_, double df_ ,
-			   bool lower_tail = true, bool log_ = false ) : 
-			vec(vec_), df(df_) , lower(lower_tail), log(log_) {}
-		
-		inline double operator[]( int i) const {
-			return ::pchisq( vec[i], df, lower, log );
-		}
-		
-		inline int size() const { return vec.size(); }
-		
-	private:
-		const VEC_TYPE& vec;
-		double df; 
-		int lower, log;
-	
-	};
-
-	template <bool NA, typename T>
-	class QChisq : public Rcpp::VectorBase< REALSXP, NA, QChisq<NA,T> >{
-	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-	
-		QChisq( const VEC_TYPE& vec_, double df_ ,
-			   bool lower_tail = true, bool log_ = false ) : 
-			vec(vec_), df(df_), lower(lower_tail), log(log_) {}
-		
-		inline double operator[]( int i) const {
-			return ::qchisq( vec[i], df, lower, log );
-		}
-		
-		inline int size() const { return vec.size(); }
-		
-	private:
-		const VEC_TYPE& vec;
-		double df; 
-		int lower, log;
-	
-	};
-	
-} // stats
-
-template <bool NA, typename T>
-inline stats::DChisq<NA,T> dchisq( const Rcpp::VectorBase<REALSXP,NA,T>& x, double df_, bool log = false ) {
-	return stats::DChisq<NA,T>( x, df_, log ); 
-}
-
-template <bool NA, typename T>
-inline stats::PChisq<NA,T> pchisq( const Rcpp::VectorBase<REALSXP,NA,T>& x, double df_, bool lower = true, bool log = false ) {
-	return stats::PChisq<NA,T>( x, df_, lower, log ); 
-}
-
-template <bool NA, typename T>
-inline stats::QChisq<NA,T> qchisq( const Rcpp::VectorBase<REALSXP,NA,T>& x, double df_, bool lower = true, bool log = false ) {
-	return stats::QChisq<NA,T>( x, df_, lower, log ); 
-}
-	
-}
-
 #endif
 

Modified: pkg/Rcpp/inst/include/Rcpp/stats/dpq/dpq.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/dpq/dpq.h	2010-08-14 17:46:02 UTC (rev 2004)
+++ pkg/Rcpp/inst/include/Rcpp/stats/dpq/dpq.h	2010-08-15 07:48:48 UTC (rev 2005)
@@ -22,15 +22,17 @@
 #ifndef Rcpp__stats__dpq__dpq_h
 #define Rcpp__stats__dpq__dpq_h
 
+#include <Rcpp/stats/dpq/macros.h>
+
 namespace Rcpp {
 namespace stats {
 
 	// D
 	
-	template <bool NA, typename T>
-	class D0 : public Rcpp::VectorBase< REALSXP, NA, D0<NA,T> > {
+	template <int RTYPE, bool NA, typename T>
+	class D0 : public Rcpp::VectorBase< REALSXP, NA, D0<RTYPE,NA,T> > {
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(int) ;
 		
 		D0( FunPtr ptr_, const VEC_TYPE& vec_, bool log_ ) : 
@@ -48,10 +50,10 @@
 		int log;
 	} ;
 
-	template <bool NA, typename T>
-	class D1 : public Rcpp::VectorBase< REALSXP, NA, D1<NA,T> > {
+	template <int RTYPE, bool NA, typename T>
+	class D1 : public Rcpp::VectorBase< REALSXP, NA, D1<RTYPE,NA,T> > {
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,int) ;
 		
 		D1( FunPtr ptr_, const VEC_TYPE& vec_, double p0_ , bool log_) : 
@@ -70,10 +72,10 @@
 		int log;
 	} ;
 	
-	template <bool NA, typename T>
-	class D2 : public Rcpp::VectorBase< REALSXP, NA, D2<NA,T> > {
+	template <int RTYPE, bool NA, typename T>
+	class D2 : public Rcpp::VectorBase< REALSXP, NA, D2<RTYPE,NA,T> > {
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,double,int) ;
 		
 		D2( FunPtr ptr_, const VEC_TYPE& vec_, double p0_, double p1_ , bool log_) : 
@@ -92,10 +94,10 @@
 		int log;
 	} ;
 
-	template <bool NA, typename T>
-	class D3 : public Rcpp::VectorBase< REALSXP, NA, D3<NA,T> > {
+	template <int RTYPE, bool NA, typename T>
+	class D3 : public Rcpp::VectorBase< REALSXP, NA, D3<RTYPE,NA,T> > {
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,double,double,int) ;
 		
 		D3( FunPtr ptr_, const VEC_TYPE& vec_, double p0_, double p1_, double p2_ , bool log_ ) : 
@@ -117,10 +119,10 @@
 	// P
 
 	
-	template <bool NA, typename T>
-	class P0 : public Rcpp::VectorBase< REALSXP, NA, P0<NA,T> >{
+	template <int RTYPE, bool NA, typename T>
+	class P0 : public Rcpp::VectorBase< REALSXP, NA, P0<RTYPE,NA,T> >{
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,int,int) ;
 		
 		P0( FunPtr ptr_, const VEC_TYPE& vec_,
@@ -141,10 +143,10 @@
 	};
 
 
-	template <bool NA, typename T>
-	class P1 : public Rcpp::VectorBase< REALSXP, NA, P1<NA,T> >{
+	template <int RTYPE, bool NA, typename T>
+	class P1 : public Rcpp::VectorBase< REALSXP, NA, P1<RTYPE,NA,T> >{
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,int,int) ;
 		
 		P1( FunPtr ptr_, const VEC_TYPE& vec_, double p0_, 
@@ -166,10 +168,10 @@
 	};
 
 
-	template <bool NA, typename T>
-	class P2 : public Rcpp::VectorBase< REALSXP, NA, P2<NA,T> >{
+	template <int RTYPE, bool NA, typename T>
+	class P2 : public Rcpp::VectorBase< REALSXP, NA, P2<RTYPE,NA,T> >{
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,double,int,int) ;
 		
 		P2( FunPtr ptr_, const VEC_TYPE& vec_, double p0_, double p1_, 
@@ -190,10 +192,10 @@
 	
 	};
 
-	template <bool NA, typename T>
-	class P3 : public Rcpp::VectorBase< REALSXP, NA, P3<NA,T> >{
+	template <int RTYPE, bool NA, typename T>
+	class P3 : public Rcpp::VectorBase< REALSXP, NA, P3<RTYPE,NA,T> >{
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,double,double,int,int) ;
 		
 		P3( FunPtr ptr_, const VEC_TYPE& vec_, double p0_, double p1_, double p2_,  
@@ -217,10 +219,10 @@
 	// Q
 	
 	
-	template <bool NA, typename T>
-	class Q0 : public Rcpp::VectorBase< REALSXP, NA, Q0<NA,T> >{
+	template <int RTYPE, bool NA, typename T>
+	class Q0 : public Rcpp::VectorBase< REALSXP, NA, Q0<RTYPE,NA,T> >{
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,int,int) ;
 		
 		Q0( FunPtr ptr_, const VEC_TYPE& vec_,
@@ -240,10 +242,10 @@
 	
 	};
 
-	template <bool NA, typename T>
-	class Q1 : public Rcpp::VectorBase< REALSXP, NA, Q1<NA,T> >{
+	template <int RTYPE, bool NA, typename T>
+	class Q1 : public Rcpp::VectorBase< REALSXP, NA, Q1<RTYPE,NA,T> >{
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,int,int) ;
 		
 		Q1( FunPtr ptr_, const VEC_TYPE& vec_, double p0_,
@@ -264,10 +266,10 @@
 	
 	};
 
-	template <bool NA, typename T>
-	class Q2 : public Rcpp::VectorBase< REALSXP, NA, Q2<NA,T> >{
+	template <int RTYPE, bool NA, typename T>
+	class Q2 : public Rcpp::VectorBase< REALSXP, NA, Q2<RTYPE,NA,T> >{
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,double,int,int) ;
 		
 		Q2( FunPtr ptr_, const VEC_TYPE& vec_, double p0_, double p1_,
@@ -288,10 +290,10 @@
 	
 	};
 
-	template <bool NA, typename T>
-	class Q3 : public Rcpp::VectorBase< REALSXP, NA, Q3<NA,T> >{
+	template <int RTYPE, bool NA, typename T>
+	class Q3 : public Rcpp::VectorBase< REALSXP, NA, Q3<RTYPE,NA,T> >{
 	public:
-		typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+		typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
 		typedef double (*FunPtr)(double,double,double,double,int,int) ;
 		
 		Q3( FunPtr ptr_, const VEC_TYPE& vec_, double p0_, double p1_, double p2_, 
@@ -318,91 +320,91 @@
 
 #define RCPP_DPQ_0(__NAME__,__D__,__P__,__Q__)                                         \
 namespace Rcpp {                                                                       \
-template <bool NA, typename T>                                                         \
-inline stats::D0<NA,T> d##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, bool log = false                          \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::D0<RTYPE,NA,T> d##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, bool log = false                          \
 ) {                                                                                    \
-	return stats::D0<NA,T>( __D__, x, log );                                           \
+	return stats::D0<RTYPE,NA,T>( __D__, x, log );                                           \
 }                                                                                      \
-template <bool NA, typename T>                                                         \
-inline stats::P0<NA,T> p##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, bool lower = true, bool log = false       \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::P0<RTYPE,NA,T> p##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, bool lower = true, bool log = false       \
 ) {                                                                                    \
-	return stats::P0<NA,T>( __P__, x, lower, log );                                    \
+	return stats::P0<RTYPE,NA,T>( __P__, x, lower, log );                                    \
 }                                                                                      \
-template <bool NA, typename T>                                                         \
-inline stats::Q0<NA,T> q##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, bool lower = true, bool log = false       \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::Q0<RTYPE,NA,T> q##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, bool lower = true, bool log = false       \
 ) {                                                                                    \
-	return stats::Q0<NA,T>( __Q__, x, lower, log );                                    \
+	return stats::Q0<RTYPE,NA,T>( __Q__, x, lower, log );                                    \
 } }
 
 
 #define RCPP_DPQ_1(__NAME__,__D__,__P__,__Q__)                                         \
 namespace Rcpp {                                                                       \
-template <bool NA, typename T>                                                         \
-inline stats::D1<NA,T> d##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, bool log = false                          \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::D1<RTYPE,NA,T> d##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, bool log = false                          \
 ) {                                                                                    \
-	return stats::D1<NA,T>( __D__, x, p0, log );                                           \
+	return stats::D1<RTYPE,NA,T>( __D__, x, p0, log );                                           \
 }                                                                                      \
-template <bool NA, typename T>                                                         \
-inline stats::P1<NA,T> p##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, bool lower = true, bool log = false       \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::P1<RTYPE,NA,T> p##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, bool lower = true, bool log = false       \
 ) {                                                                                    \
-	return stats::P1<NA,T>( __P__, x, p0, lower, log );                                    \
+	return stats::P1<RTYPE,NA,T>( __P__, x, p0, lower, log );                                    \
 }                                                                                      \
-template <bool NA, typename T>                                                         \
-inline stats::Q1<NA,T> q##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, bool lower = true, bool log = false       \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::Q1<RTYPE,NA,T> q##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, bool lower = true, bool log = false       \
 ) {                                                                                    \
-	return stats::Q1<NA,T>( __Q__, x, p0, lower, log );                                    \
+	return stats::Q1<RTYPE,NA,T>( __Q__, x, p0, lower, log );                                    \
 } }
 
 
 
 #define RCPP_DPQ_2(__NAME__,__D__,__P__,__Q__)                                         \
 namespace Rcpp {                                                                       \
-template <bool NA, typename T>                                                         \
-inline stats::D2<NA,T> d##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, double p1, bool log = false                          \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::D2<RTYPE,NA,T> d##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, double p1, bool log = false                          \
 ) {                                                                                    \
-	return stats::D2<NA,T>( __D__, x, p0, p1, log );                                           \
+	return stats::D2<RTYPE,NA,T>( __D__, x, p0, p1, log );                                           \
 }                                                                                      \
-template <bool NA, typename T>                                                         \
-inline stats::P2<NA,T> p##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, double p1, bool lower = true, bool log = false       \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::P2<RTYPE,NA,T> p##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, double p1, bool lower = true, bool log = false       \
 ) {                                                                                    \
-	return stats::P2<NA,T>( __P__, x, p0, p1, lower, log );                                    \
+	return stats::P2<RTYPE,NA,T>( __P__, x, p0, p1, lower, log );                                    \
 }                                                                                      \
-template <bool NA, typename T>                                                         \
-inline stats::Q2<NA,T> q##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, double p1, bool lower = true, bool log = false       \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::Q2<RTYPE,NA,T> q##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, double p1, bool lower = true, bool log = false       \
 ) {                                                                                    \
-	return stats::Q2<NA,T>( __Q__, x, p0, p1, lower, log );                                    \
+	return stats::Q2<RTYPE,NA,T>( __Q__, x, p0, p1, lower, log );                                    \
 } }
 
 
 
 #define RCPP_DPQ_3(__NAME__,__D__,__P__,__Q__)                                         \
 namespace Rcpp {                                                                       \
-template <bool NA, typename T>                                                         \
-inline stats::D3<NA,T> d##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, double p1, double p2, bool log = false                          \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::D3<RTYPE,NA,T> d##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, double p1, double p2, bool log = false                          \
 ) {                                                                                    \
-	return stats::D3<NA,T>( __D__, x, p0, p1, p2, log );                                           \
+	return stats::D3<RTYPE,NA,T>( __D__, x, p0, p1, p2, log );                                           \
 }                                                                                      \
-template <bool NA, typename T>                                                         \
-inline stats::P3<NA,T> p##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, double p1, double p2, bool lower = true, bool log = false       \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::P3<RTYPE,NA,T> p##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, double p1, double p2, bool lower = true, bool log = false       \
 ) {                                                                                    \
-	return stats::P3<NA,T>( __P__, x, p0, p1, p2, lower, log );                                    \
+	return stats::P3<RTYPE,NA,T>( __P__, x, p0, p1, p2, lower, log );                                    \
 }                                                                                      \
-template <bool NA, typename T>                                                         \
-inline stats::Q3<NA,T> q##__NAME__(                                                    \
-	const Rcpp::VectorBase<REALSXP,NA,T>& x, double p0, double p1, double p2, bool lower = true, bool log = false       \
+template <int RTYPE, bool NA, typename T>                                                         \
+inline stats::Q3<RTYPE,NA,T> q##__NAME__(                                                    \
+	const Rcpp::VectorBase<RTYPE,NA,T>& x, double p0, double p1, double p2, bool lower = true, bool log = false       \
 ) {                                                                                    \
-	return stats::Q3<NA,T>( __Q__, x, p0, p1, p2, lower, log );                                    \
+	return stats::Q3<RTYPE,NA,T>( __Q__, x, p0, p1, p2, lower, log );                                    \
 } }
 
 

Added: pkg/Rcpp/inst/include/Rcpp/stats/dpq/macros.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/dpq/macros.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/stats/dpq/macros.h	2010-08-15 07:48:48 UTC (rev 2005)
@@ -0,0 +1,127 @@
+/*
+ *  R : A Computer Language for Statistical Data Analysis
+ *  Copyright (C) 2000--2007  R Development Core Team
+ *
+ *  This program 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.
+ *
+ *  This program 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 this program; if not, a copy is available at
+ *  http://www.r-project.org/Licenses/
+ */
+	/* Utilities for `dpq' handling (density/probability/quantile) */
+
+/* This is borrowed from R, with some changes */
+	
+/* give_log in "d";  log_p in "p" & "q" : */
+#define give_log log_p
+							/* "DEFAULT" */
+							/* --------- */
+#define R_D__0	(log_p ? ML_NEGINF : 0.)		/* 0 */
+#define R_D__1	(log_p ? 0. : 1.)			/* 1 */
+#define R_DT_0	(lower_tail ? R_D__0 : R_D__1)		/* 0 */
+#define R_DT_1	(lower_tail ? R_D__1 : R_D__0)		/* 1 */
+
+/* Use 0.5 - p + 0.5 to perhaps gain 1 bit of accuracy */
+#define R_D_Lval(p)	(lower_tail ? (p) : (0.5 - (p) + 0.5))	/*  p  */
+#define R_D_Cval(p)	(lower_tail ? (0.5 - (p) + 0.5) : (p))	/*  1 - p */
+
+#define R_D_val(x)	(log_p	? ::log(x) : (x))		/*  x  in pF(x,..) */
+#define R_D_qIv(p)	(log_p	? ::exp(p) : (p))		/*  p  in qF(p,..) */
+#define R_D_exp(x)	(log_p	?  (x)	 : ::exp(x))	/* exp(x) */
+#define R_D_log(p)	(log_p	?  (p)	 : ::log(p))	/* log(p) */
+#define R_D_Clog(p)	(log_p	? ::log1p(-(p)) : (0.5 - (p) + 0.5)) /* [log](1-p) */
+
+/* log(1 - exp(x))  in more stable form than log1p(- R_D_qIv(x))) : */
+#define R_Log1_Exp(x)   ((x) > -M_LN2 ? ::log(-::expm1(x)) : ::log1p(-::exp(x)))
+
+/* log(1-exp(x)):  R_D_LExp(x) == (log1p(- R_D_qIv(x))) but even more stable:*/
+#define R_D_LExp(x)     (log_p ? R_Log1_Exp(x) : ::log1p(-x))
+
+#define R_DT_val(x)	(lower_tail ? R_D_val(x)  : R_D_Clog(x))
+#define R_DT_Cval(x)	(lower_tail ? R_D_Clog(x) : R_D_val(x))
+
+/*#define R_DT_qIv(p)	R_D_Lval(R_D_qIv(p))		 *  p  in qF ! */
+#define R_DT_qIv(p)	(log_p ? (lower_tail ? ::exp(p) : - ::expm1(p)) \
+			       : R_D_Lval(p))
+
+/*#define R_DT_CIv(p)	R_D_Cval(R_D_qIv(p))		 *  1 - p in qF */
+#define R_DT_CIv(p)	(log_p ? (lower_tail ? -expm1(p) : ::exp(p)) \
+			       : R_D_Cval(p))
+
+#define R_DT_exp(x)	R_D_exp(R_D_Lval(x))		/* exp(x) */
+#define R_DT_Cexp(x)	R_D_exp(R_D_Cval(x))		/* exp(1 - x) */
+
+#define R_DT_log(p)	(lower_tail? R_D_log(p) : R_D_LExp(p))/* log(p) in qF */
+#define R_DT_Clog(p)	(lower_tail? R_D_LExp(p): R_D_log(p))/* log(1-p) in qF*/
+#define R_DT_Log(p)	(lower_tail? (p) : R_Log1_Exp(p))
+/* ==   R_DT_log when we already "know" log_p == TRUE :*/
+
+
+#define R_Q_P01_check(p)			\
+    if ((log_p	&& p > 0) ||			\
+	(!log_p && (p < 0 || p > 1)) )		\
+	ML_ERR_return_NAN
+
+/* Do the boundaries exactly for q*() functions :
+ * Often  _LEFT_ = ML_NEGINF , and very often _RIGHT_ = ML_POSINF;
+ *
+ * R_Q_P01_boundaries(p, _LEFT_, _RIGHT_)  :<==>
+ *
+ *     R_Q_P01_check(p);
+ *     if (p == R_DT_0) return _LEFT_ ;
+ *     if (p == R_DT_1) return _RIGHT_;
+ *
+ * the following implementation should be more efficient (less tests):
+ */
+#define R_Q_P01_boundaries(p, _LEFT_, _RIGHT_)		\
+    if (log_p) {					\
+	if(p > 0)					\
+	    return R_NaN ;				\
+	if(p == 0) /* upper bound*/			\
+	    return lower_tail ? _RIGHT_ : _LEFT_;	\
+	if(p == ML_NEGINF)				\
+	    return lower_tail ? _LEFT_ : _RIGHT_;	\
+    }							\
+    else { /* !log_p */					\
+	if(p < 0 || p > 1)				\
+	    return R_NaN ;				\
+	if(p == 0)					\
+	    return lower_tail ? _LEFT_ : _RIGHT_;	\
+	if(p == 1)					\
+	    return lower_tail ? _RIGHT_ : _LEFT_;	\
+    }
+
+#define R_P_bounds_01(x, x_min, x_max) 	\
+    if(x <= x_min) return R_DT_0;		\
+    if(x >= x_max) return R_DT_1
+/* is typically not quite optimal for (-Inf,Inf) where
+ * you'd rather have */
+#define R_P_bounds_Inf_01(x)			\
+    if(!R_FINITE(x)) {				\
+	if (x > 0) return R_DT_1;		\
+	/* x < 0 */return R_DT_0;		\
+    }
+
+
+
+/* additions for density functions (C.Loader) */
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/rcpp -r 2005


More information about the Rcpp-commits mailing list