[Rcpp-commits] r1911 - in pkg/Rcpp/inst: . include include/Rcpp include/Rcpp/stats include/Rcpp/sugar include/Rcpp/sugar/functions unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 5 11:18:13 CEST 2010
Author: romain
Date: 2010-08-05 11:18:12 +0200 (Thu, 05 Aug 2010)
New Revision: 1911
Added:
pkg/Rcpp/inst/include/Rcpp/stats/
pkg/Rcpp/inst/include/Rcpp/stats/binom.h
pkg/Rcpp/inst/include/Rcpp/stats/pois.h
pkg/Rcpp/inst/include/Rcpp/stats/stats.h
pkg/Rcpp/inst/unitTests/runit.stats.R
Modified:
pkg/Rcpp/inst/ChangeLog
pkg/Rcpp/inst/include/Rcpp.h
pkg/Rcpp/inst/include/Rcpp/sugar/Range.h
pkg/Rcpp/inst/include/Rcpp/sugar/functions/seq_along.h
pkg/Rcpp/inst/include/RcppCommon.h
Log:
new sugar functions Rcpp::stats::dpois and Rcpp::stats::dbinom (more to come)
Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog 2010-08-05 02:43:12 UTC (rev 1910)
+++ pkg/Rcpp/inst/ChangeLog 2010-08-05 09:18:12 UTC (rev 1911)
@@ -1,5 +1,16 @@
2010-08-04 Romain Francois <romain at r-enthusiasts.com>
+ * inst/include/Rcpp/sugar/functions/seq_along.h: added seq(int,int) to
+ mimic the R syntax : seq( 0, 5 )
+
+ * inst/include/Rcpp/sugar/Range.h: fixed compiler confusion
+
+ * inst/include/Rcpp/stats: new sugar functions Rcpp::stats::dpois and
+ Rcpp::stats::dbinom inspired by Richard Chandler post on Rcpp-devel:
+ http://lists.r-forge.r-project.org/pipermail/rcpp-devel/2010-August/000940.html
+
+2010-08-04 Romain Francois <romain at r-enthusiasts.com>
+
* inst/include/Rcpp/sugar/: rework sugar matrix so that operator()(int,int)
is always used instead of operator[](int)
Added: pkg/Rcpp/inst/include/Rcpp/stats/binom.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/binom.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/stats/binom.h 2010-08-05 09:18:12 UTC (rev 1911)
@@ -0,0 +1,85 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// binom.h: Rcpp R/C++ interface class library --
+//
+// 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__binom_h
+#define Rcpp__stats__binom_h
+
+namespace Rcpp{
+namespace stats{
+namespace impl{
+
+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 {
+ int x = vec[i] ;
+ return Rcpp::traits::is_na<INTSXP>( x ) ? NA_REAL : ::dbinom( x, n, prob, log ) ;
+ }
+
+ inline int size() const { return vec.size(); }
+
+private:
+ const VEC_TYPE& vec ;
+ int n ;
+ double prob ;
+ int log ;
+
+} ;
+
+template <typename T>
+class DBinom<false,T> : public Rcpp::VectorBase< REALSXP, false, DBinom<false,T> >{
+public:
+ typedef typename Rcpp::VectorBase<INTSXP,false,T> VEC_TYPE ;
+
+ DBinom( const VEC_TYPE& vec_, int n_, double prob_, bool log_ ) :
+ vec(vec_), n(n_), prob(prob_), log(log_) {}
+
+ inline double operator[]( int i) const {
+ return ::dbinom( vec[i], n, prob, log ) ;
+ }
+
+ inline int size() const { return vec.size(); }
+
+private:
+ const VEC_TYPE& vec ;
+ int n ;
+ double prob ;
+ int log ;
+
+} ;
+
+
+} // impl
+
+template <bool NA, typename T>
+inline impl::DBinom<NA,T> dbinom( const Rcpp::VectorBase<INTSXP,NA,T>& x, int size, double prob, bool log = false ){
+ return impl::DBinom<NA,T>( x, size, prob );
+}
+
+}
+}
+
+#endif
Added: pkg/Rcpp/inst/include/Rcpp/stats/pois.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/pois.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/stats/pois.h 2010-08-05 09:18:12 UTC (rev 1911)
@@ -0,0 +1,83 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// pois.h: Rcpp R/C++ interface class library --
+//
+// 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__pois_h
+#define Rcpp__stats__pois_h
+
+namespace Rcpp{
+namespace stats{
+namespace impl{
+
+template <bool NA, typename T>
+class DPois : public Rcpp::VectorBase< REALSXP, NA, DPois<NA,T> >{
+public:
+ typedef typename Rcpp::VectorBase<INTSXP,NA,T> VEC_TYPE ;
+
+ DPois( const VEC_TYPE& vec_, double lambda_, bool log_ = false ) :
+ vec(vec_), lambda(lambda_), log(log_) {}
+
+ inline double operator[]( int i) const {
+ int x = vec[i] ;
+ return Rcpp::traits::is_na<INTSXP>( x ) ? NA_REAL : ::dpois( x, lambda, log ) ;
+ }
+
+ inline int size() const { return vec.size(); }
+
+private:
+ const VEC_TYPE& vec ;
+ double lambda ;
+ int log ;
+
+} ;
+
+template <typename T>
+class DPois<false,T> : public Rcpp::VectorBase< REALSXP, false, DPois<false,T> >{
+public:
+ typedef typename Rcpp::VectorBase<INTSXP,false,T> VEC_TYPE ;
+
+ DPois( const VEC_TYPE& vec_, double lambda_, bool log_ = false ) :
+ vec(vec_), lambda(lambda_), log(log_) {}
+
+ inline double operator[]( int i) const {
+ return ::dpois( vec[i], lambda, log ) ;
+ }
+
+ inline int size() const { return vec.size(); }
+
+private:
+ const VEC_TYPE& vec ;
+ double lambda ;
+ int log ;
+
+} ;
+
+
+} // impl
+
+template <bool NA, typename T>
+inline impl::DPois<NA,T> dpois( const Rcpp::VectorBase<INTSXP,NA,T>& x, double lambda, bool log = false ){
+ return impl::DPois<NA,T>( x, lambda, log );
+}
+
+}
+}
+
+#endif
Added: pkg/Rcpp/inst/include/Rcpp/stats/stats.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/stats.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/stats/stats.h 2010-08-05 09:18:12 UTC (rev 1911)
@@ -0,0 +1,28 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// binom.h: Rcpp R/C++ interface class library --
+//
+// 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__stats_h
+#define Rcpp__stats__stats_h
+
+#include <Rcpp/stats/binom.h>
+#include <Rcpp/stats/pois.h>
+
+#endif
Modified: pkg/Rcpp/inst/include/Rcpp/sugar/Range.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/Range.h 2010-08-05 02:43:12 UTC (rev 1910)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/Range.h 2010-08-05 09:18:12 UTC (rev 1911)
@@ -26,14 +26,14 @@
class Range : public VectorBase<INTSXP,false, Range >{
public:
- Range( int start_, int end_ ) throw(std::range_error) : start(start_), end(end_){
+ Range( int start_, int end__ ) throw(std::range_error) : start(start_), end_(end__){
if( start_ > end_ ){
throw std::range_error( "upper value must be greater than lower value" ) ;
}
}
inline int size() const{
- return end - start + 1;
+ return end_ - start + 1;
}
inline int operator[]( int i) const {
@@ -42,7 +42,7 @@
private:
int start ;
- int end ;
+ int end_ ;
} ;
}
Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/seq_along.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/seq_along.h 2010-08-05 02:43:12 UTC (rev 1910)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/seq_along.h 2010-08-05 09:18:12 UTC (rev 1911)
@@ -49,6 +49,9 @@
return sugar::SeqLen( n ) ;
}
+inline Range seq(int start, int end){
+ return Range( start, end ) ;
+}
} // Rcpp
Modified: pkg/Rcpp/inst/include/Rcpp.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp.h 2010-08-05 02:43:12 UTC (rev 1910)
+++ pkg/Rcpp/inst/include/Rcpp.h 2010-08-05 09:18:12 UTC (rev 1911)
@@ -64,6 +64,7 @@
#include <Rcpp/InternalFunction.h>
#include <Rcpp/sugar/sugar.h>
+#include <Rcpp/stats/stats.h>
#include <classic/classic_backward.h>
Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h 2010-08-05 02:43:12 UTC (rev 1910)
+++ pkg/Rcpp/inst/include/RcppCommon.h 2010-08-05 09:18:12 UTC (rev 1911)
@@ -107,6 +107,7 @@
#include <R_ext/Parse.h>
#include <R_ext/Rdynload.h>
#include <Rversion.h>
+#include <Rmath.h>
#define RCPP_GET_NAMES(x) Rf_getAttrib(x, R_NamesSymbol)
#if defined(R_VERSION) && R_VERSION >= R_Version(2, 12, 0)
@@ -275,7 +276,6 @@
#include <Rcpp/preprocessor.h>
#include <Rcpp/algo.h>
-
#include <Rcpp/sugar/sugar_forward.h>
#endif
Added: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-05 09:18:12 UTC (rev 1911)
@@ -0,0 +1,66 @@
+#!/usr/bin/r -t
+#
+# 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/>.
+
+.setUp <- function(){
+ if( ! exists( ".rcpp.stats", globalenv() ) ){
+ # definition of all the functions at once
+
+ f <- list(
+ "runit_dbinom" = list(
+ signature( x = "integer" ),
+ '
+ IntegerVector xx(x) ;
+ return List::create(
+ _["false"] = stats::dbinom( xx, 10, .5),
+ _["true"] = stats::dbinom( xx, 10, .5, true )
+ ) ;
+ '
+ ),
+ "runit_dpois" = list(
+ signature( x = "integer" ),
+ '
+ IntegerVector xx(x) ;
+ return List::create(
+ _["false"] = stats::dpois( xx, .5 ),
+ _["true"] = stats::dpois( xx, .5 , true )
+ ) ;
+ '
+ ),
+ )
+
+ signatures <- lapply( f, "[[", 1L )
+ bodies <- lapply( f, "[[", 2L )
+ fx <- cxxfunction( signatures, bodies, plugin = "Rcpp")
+ getDynLib( fx ) # just forcing loading the dll now
+ assign( ".rcpp.stats", fx, globalenv() )
+ }
+}
+
+test.stats.dbinom <- function( ){
+ fx <- .rcpp.stats$runit_dbinom
+ checkEquals( fx(1:10) ,
+ list( false = dbinom(1:10, 10, .5), true = dbinom(1:10, 10, .5, TRUE ) )
+}
+
+test.stats.dpois <- function( ){
+ fx <- .rcpp.stats$runit_dpois
+ checkEquals( fx(0:5) ,
+ list( false = dpois(0:5, .4), true = dpois(0:5, .4, TRUE ) )
+}
+
More information about the Rcpp-commits
mailing list