[Rcpp-commits] r2012 - in pkg/Rcpp/inst: include/Rcpp/stats include/Rcpp/stats/dpq unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Aug 15 13:27:03 CEST 2010
Author: romain
Date: 2010-08-15 13:27:02 +0200 (Sun, 15 Aug 2010)
New Revision: 2012
Modified:
pkg/Rcpp/inst/include/Rcpp/stats/dpq/macros.h
pkg/Rcpp/inst/include/Rcpp/stats/lnorm.h
pkg/Rcpp/inst/include/Rcpp/stats/unif.h
pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
dpq unif using RCPP_DPQ
Modified: pkg/Rcpp/inst/include/Rcpp/stats/dpq/macros.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/dpq/macros.h 2010-08-15 11:08:51 UTC (rev 2011)
+++ pkg/Rcpp/inst/include/Rcpp/stats/dpq/macros.h 2010-08-15 11:27:02 UTC (rev 2012)
@@ -68,7 +68,7 @@
#define R_Q_P01_check(p) \
if ((log_p && p > 0) || \
(!log_p && (p < 0 || p > 1)) ) \
- ML_ERR_return_NAN
+ return R_NaN
/* Do the boundaries exactly for q*() functions :
* Often _LEFT_ = ML_NEGINF , and very often _RIGHT_ = ML_POSINF;
Modified: pkg/Rcpp/inst/include/Rcpp/stats/lnorm.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/lnorm.h 2010-08-15 11:08:51 UTC (rev 2011)
+++ pkg/Rcpp/inst/include/Rcpp/stats/lnorm.h 2010-08-15 11:27:02 UTC (rev 2012)
@@ -72,7 +72,7 @@
#endif
if (x > 0)
- return ::Rf_pnorm5(::log(x), 0.0, 1.0, lower_tail, log_p);
+ return Rcpp::stats::pnorm_0(::log(x), lower_tail, log_p);
return R_DT_0;
}
@@ -82,9 +82,8 @@
return x + meanlog + 1.0 ;
#endif
- // TODO : use Rcpp::stats::pnorm_1
- if (x > 0)
- return ::Rf_pnorm5(::log(x), meanlog, 1.0, lower_tail, log_p);
+ if (x > 0)
+ return Rcpp::stats::pnorm_1(::log(x), meanlog, lower_tail, log_p);
return R_DT_0;
}
@@ -95,7 +94,6 @@
#endif
R_Q_P01_boundaries(p, 0, ML_POSINF);
- // TODO : use Rcpp::stats::qnorm_0
return ::exp(::Rf_qnorm5(p, 0.0, 1.0, lower_tail, log_p));
}
@@ -106,7 +104,6 @@
#endif
R_Q_P01_boundaries(p, 0, ML_POSINF);
- // TODO : use Rcpp::stats::qnorm_1
return ::exp(::Rf_qnorm5(p, meanlog, 1.0, lower_tail, log_p));
}
Modified: pkg/Rcpp/inst/include/Rcpp/stats/unif.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/unif.h 2010-08-15 11:08:51 UTC (rev 2011)
+++ pkg/Rcpp/inst/include/Rcpp/stats/unif.h 2010-08-15 11:27:02 UTC (rev 2012)
@@ -28,90 +28,67 @@
namespace Rcpp {
namespace stats {
+inline double dunif_1(double x, double a/*, double b [=1.]*/ , int give_log){
+ return ::Rf_dunif(x, a, 1.0, give_log ) ;
+}
+inline double dunif_0( double x /*, double a [=0.], double b [=1.]*/ , int give_log){
+#ifdef IEEE_754
+ if (ISNAN(x) )
+ return x + 1.0 ;
+#endif
+
+ if (0.0 <= x && x <= 1.0)
+ return 1.0 ;
+ return R_D__0;
+}
- template <bool NA, typename T>
- class DUnif : public Rcpp::VectorBase< REALSXP, NA, DUnif<NA,T> >{
- public:
- typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-
- DUnif( const VEC_TYPE& vec_, double min_ = 0.0, double max_ = 1.0 , bool log_ = false ) :
- vec(vec_), min(min_), max(max_) , log(log_) {}
-
- inline double operator[]( int i) const {
- return ::Rf_dunif( vec[i], min, max , log );
- }
-
- inline int size() const { return vec.size(); }
-
- private:
- const VEC_TYPE& vec;
- double min; double max;
- int log;
-
- };
- template <bool NA, typename T>
- class PUnif : public Rcpp::VectorBase< REALSXP, NA, PUnif<NA,T> >{
- public:
- typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+inline double punif_1(double x, double a /*, double b [=1.0]*/, int lower_tail, int log_p) {
+ return ::Rf_punif( x, a, 1.0, lower_tail, log_p ) ;
+}
+inline double punif_0(double x /*, double a [=0.0], double b [=1.0]*/, int lower_tail, int log_p) {
+#ifdef IEEE_754
+ if (ISNAN(x))
+ return x + 1.0 ;
+#endif
+ if (x >= 1.0)
+ return R_DT_1;
+ if (x <= 0.0)
+ return R_DT_0;
+ if (lower_tail) return R_D_val(x);
+ else return R_D_val(1-x);
- PUnif( const VEC_TYPE& vec_, double min_ = 0.0, double max_ = 1.0 ,
- bool lower_tail = true, bool log_ = false ) :
- vec(vec_), min(min_), max(max_) , lower(lower_tail), log(log_) {}
-
- inline double operator[]( int i) const {
- return ::Rf_punif( vec[i], min, max, lower, log );
- }
-
- inline int size() const { return vec.size(); }
-
- private:
- const VEC_TYPE& vec;
- double min; double max;
- int lower, log;
-
- };
-
- template <bool NA, typename T>
- class QUnif : public Rcpp::VectorBase< REALSXP, NA, QUnif<NA,T> >{
- public:
- typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-
- QUnif( const VEC_TYPE& vec_, double min_ = 0.0, double max_ = 1.0 ,
- bool lower_tail = true, bool log_ = false ) :
- vec(vec_), min(min_), max(max_), lower(lower_tail), log(log_) {}
-
- inline double operator[]( int i) const {
- return ::Rf_qunif( vec[i], min, max, lower, log );
- }
-
- inline int size() const { return vec.size(); }
-
- private:
- const VEC_TYPE& vec;
- double min; double max;
- int lower, log;
-
- };
-
-} // stats
-
-template <bool NA, typename T>
-inline stats::DUnif<NA,T> dunif( const Rcpp::VectorBase<REALSXP,NA,T>& x, double min_ = 0.0, double max_ = 1.0, bool log = false ) {
- return stats::DUnif<NA,T>( x, min_, max_, log );
}
-template <bool NA, typename T>
-inline stats::PUnif<NA,T> punif( const Rcpp::VectorBase<REALSXP,NA,T>& x, double min_ = 0.0, double max_ = 1.0, bool lower = true, bool log = false ) {
- return stats::PUnif<NA,T>( x, min_, max_, lower, log );
-}
+inline double qunif_1(double p, double a /*, double b [=1.0] */, int lower_tail, int log_p) {
+#ifdef IEEE_754
+ if (ISNAN(p) || ISNAN(a) )
+ return p + a + 1.0 ;
+#endif
+ R_Q_P01_check(p);
+ if (!R_FINITE(a) ) return R_NaN;
+ if (1.0 < a) return R_NaN;
+ if (1.0 == a) return a;
-template <bool NA, typename T>
-inline stats::QUnif<NA,T> qunif( const Rcpp::VectorBase<REALSXP,NA,T>& x, double min_ = 0.0, double max_ = 1.0, bool lower = true, bool log = false ) {
- return stats::QUnif<NA,T>( x, min_, max_, lower, log );
+ return a + R_DT_qIv(p) * (1.0 - a);
}
-
+inline double qunif_0(double p /*, double a [=0.0], double b [=1.0] */, int lower_tail, int log_p) {
+#ifdef IEEE_754
+ if (ISNAN(p) )
+ return p + 1.0 ;
+#endif
+ R_Q_P01_check(p);
+
+ return R_DT_qIv(p) ;
}
+
+} // stats
+} // Rcpp
+
+RCPP_DPQ_0(unif, Rcpp::stats::dunif_0, Rcpp::stats::punif_0, Rcpp::stats::qunif_0 )
+RCPP_DPQ_1(unif, Rcpp::stats::dunif_1, Rcpp::stats::punif_1, Rcpp::stats::qunif_1 )
+RCPP_DPQ_2(unif, ::Rf_dunif, ::Rf_punif, ::Rf_qunif )
+
#endif
Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-15 11:08:51 UTC (rev 2011)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-15 11:27:02 UTC (rev 2012)
@@ -47,8 +47,8 @@
signature( x = "numeric" ),
'
NumericVector xx(x) ;
- return List::create(_["NoLog"] = dunif( xx, 0, 1),
- _["Log"] = dunif( xx, 0, 1, true ));
+ return List::create(_["NoLog"] = dunif( xx, 0.0 , 1.0 ),
+ _["Log"] = dunif( xx, 0.0, 1.0 , true ));
')
,
More information about the Rcpp-commits
mailing list