[Rcpp-commits] r2168 - in pkg/Rcpp: . R inst/examples/ConvolveBenchmarks inst/include inst/include/Rcpp inst/include/Rcpp/internal inst/include/Rcpp/sugar/nona inst/include/Rcpp/vector src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Sep 25 09:05:57 CEST 2010
Author: romain
Date: 2010-09-25 09:05:57 +0200 (Sat, 25 Sep 2010)
New Revision: 2168
Added:
pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve12_cpp.cpp
pkg/Rcpp/inst/include/Rcpp/routines.h
Modified:
pkg/Rcpp/NAMESPACE
pkg/Rcpp/R/Module.R
pkg/Rcpp/inst/examples/ConvolveBenchmarks/buildAndRun.sh
pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve11_cpp.cpp
pkg/Rcpp/inst/examples/ConvolveBenchmarks/exampleRCode.r
pkg/Rcpp/inst/include/Rcpp/internal/Proxy_Iterator.h
pkg/Rcpp/inst/include/Rcpp/sugar/nona/nona.h
pkg/Rcpp/inst/include/Rcpp/vector/Vector.h
pkg/Rcpp/inst/include/RcppCommon.h
pkg/Rcpp/src/Module.cpp
pkg/Rcpp/src/RcppCommon.cpp
pkg/Rcpp/src/Rcpp_init.c
Log:
going further with registration of routines (NAMESPACE, etc ...)
Modified: pkg/Rcpp/NAMESPACE
===================================================================
--- pkg/Rcpp/NAMESPACE 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/NAMESPACE 2010-09-25 07:05:57 UTC (rev 2168)
@@ -1,4 +1,6 @@
-useDynLib(Rcpp)
+useDynLib(Rcpp,
+ CppField__get, CppField__set
+)
import( methods )
importFrom( utils, capture.output, assignInNamespace, .DollarNames, prompt, packageDescription )
Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/R/Module.R 2010-09-25 07:05:57 UTC (rev 2168)
@@ -225,9 +225,9 @@
f <- function( x ) NULL
body(f) <- substitute({
if( missing( x ) )
- .Call("CppField__get", class_pointer, pointer, .pointer)
+ .Call( CppField__get, class_pointer, pointer, .pointer)
else
- .Call("CppField__set", class_pointer, pointer, .pointer, x)
+ .Call( CppField__set, class_pointer, pointer, .pointer, x)
}, list(class_pointer = FIELD$class_pointer,
pointer = FIELD$pointer))
environment(f) <- where
Modified: pkg/Rcpp/inst/examples/ConvolveBenchmarks/buildAndRun.sh
===================================================================
--- pkg/Rcpp/inst/examples/ConvolveBenchmarks/buildAndRun.sh 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/inst/examples/ConvolveBenchmarks/buildAndRun.sh 2010-09-25 07:05:57 UTC (rev 2168)
@@ -18,6 +18,7 @@
R CMD SHLIB convolve9_cpp.cpp
R CMD SHLIB convolve10_cpp.cpp
R CMD SHLIB convolve11_cpp.cpp
+R CMD SHLIB convolve12_cpp.cpp
# call R so that we get an interactive session
Rscript exampleRCode.r
Modified: pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve11_cpp.cpp
===================================================================
--- pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve11_cpp.cpp 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve11_cpp.cpp 2010-09-25 07:05:57 UTC (rev 2168)
@@ -1,6 +1,7 @@
// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-// This is a rewrite of the 'Writing R Extensions' section 5.10.1 example
+// This version uses nona to indicate that xb does not contain any missing
+// value. This is the assumption that all other versions do.
#include <Rcpp.h>
using namespace Rcpp ;
Added: pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve12_cpp.cpp
===================================================================
--- pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve12_cpp.cpp (rev 0)
+++ pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve12_cpp.cpp 2010-09-25 07:05:57 UTC (rev 2168)
@@ -0,0 +1,27 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+
+// This is a rewrite of the 'Writing R Extensions' section 5.10.1 example
+
+#include <Rcpp.h>
+
+template <typename T>
+T convolve( const T& a, const T& b ){
+ int na = a.size() ; int nb = b.size() ;
+ T out(na + nb - 1);
+ typename T::iterator iter_a(a.begin()), iter_b(b.begin()), iter_ab( out.begin() ) ;
+
+ for (int i = 0; i < na; i++)
+ for (int j = 0; j < nb; j++)
+ iter_ab[i + j] += iter_a[i] * iter_b[j];
+
+ return out ;
+}
+
+
+RcppExport SEXP convolve12cpp(SEXP a, SEXP b){
+ return convolve( Rcpp::NumericVector(a), Rcpp::NumericVector(b) ) ;
+}
+
+#include "loopmacro.h"
+LOOPMACRO_CPP(convolve12cpp)
+
Modified: pkg/Rcpp/inst/examples/ConvolveBenchmarks/exampleRCode.r
===================================================================
--- pkg/Rcpp/inst/examples/ConvolveBenchmarks/exampleRCode.r 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/inst/examples/ConvolveBenchmarks/exampleRCode.r 2010-09-25 07:05:57 UTC (rev 2168)
@@ -17,6 +17,7 @@
dyn.load("convolve9_cpp.so")
dyn.load("convolve10_cpp.so")
dyn.load("convolve11_cpp.so")
+dyn.load("convolve12_cpp.so" )
## now run each one once for comparison of results,
## and define test functions
@@ -32,8 +33,8 @@
#Rcpp_New_std_2 <- function(n,a,b) .Call("convolve8cpp__loop", n, a, b)
#Rcpp_New_std_3 <- function(n,a,b) .Call("convolve9cpp__loop", n, a, b)
#Rcpp_New_std_4 <- function(n,a,b) .Call("convolve10cpp__loop", n, a, b)
+Rcpp_New_std_5 <- function(n,a,b) .Call("convolve12cpp__loop", n, a, b )
-
v1 <- R_API_optimised(1L, a, b )
v2 <- Rcpp_Classic(1L,a,b)[[1]]
v3 <- Rcpp_New_std(1L, a, b)
@@ -61,6 +62,7 @@
# Rcpp_New_std_2(REPS,a,b),
# Rcpp_New_std_3(REPS,a,b),
# Rcpp_New_std_4(REPS,a,b),
+# Rcpp_New_std_5(REPS,a,b),
columns=c("test", "elapsed", "relative", "user.self", "sys.self"),
order="relative",
replications=1)
Modified: pkg/Rcpp/inst/include/Rcpp/internal/Proxy_Iterator.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/internal/Proxy_Iterator.h 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/inst/include/Rcpp/internal/Proxy_Iterator.h 2010-09-25 07:05:57 UTC (rev 2168)
@@ -109,6 +109,8 @@
}
inline int index() const { return proxy.index ; }
+
+ inline PROXY operator[](int i){ return PROXY(*proxy.parent, proxy.index + i) ; }
private:
PROXY proxy ;
Added: pkg/Rcpp/inst/include/Rcpp/routines.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/routines.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/routines.h 2010-09-25 07:05:57 UTC (rev 2168)
@@ -0,0 +1,39 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// routines.h: Rcpp R/C++ interface class library -- .Call exported routines
+//
+// Copyright (C) 2010 John Chambers, 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__routines_h
+#define Rcpp__routines_h
+
+// we have to do the ifdef __cplusplus dance because this file
+// is included both in C and C++ files
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+SEXP CppField__get(SEXP, SEXP, SEXP);
+SEXP CppField__set(SEXP, SEXP, SEXP, SEXP);
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif
Modified: pkg/Rcpp/inst/include/Rcpp/sugar/nona/nona.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/nona/nona.h 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/nona/nona.h 2010-09-25 07:05:57 UTC (rev 2168)
@@ -57,6 +57,15 @@
iterator data ;
} ;
+ template <typename T>
+ class NonaPrimitive {
+ public:
+ NonaPrimitive( T t) : x(t){}
+ operator T(){ return x ; }
+
+ private:
+ T x ;
+ } ;
}
@@ -65,6 +74,11 @@
return sugar::Nona<RTYPE,NA,VECTOR>( vec ) ;
}
+inline sugar::NonaPrimitive<double> nona( double x ){
+ return sugar::NonaPrimitive<double>( x ) ;
}
+
+}
+
#endif
Modified: pkg/Rcpp/inst/include/Rcpp/vector/Vector.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/Vector.h 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/inst/include/Rcpp/vector/Vector.h 2010-09-25 07:05:57 UTC (rev 2168)
@@ -26,7 +26,7 @@
class Vector :
public RObject,
public VectorBase< RTYPE, true, Vector<RTYPE> >,
- public internal::eval_methods<RTYPE>
+ public internal::eval_methods<RTYPE>
{
public:
typedef typename traits::r_vector_proxy<RTYPE>::type Proxy ;
@@ -318,8 +318,11 @@
inline iterator begin() const{ return cache.get() ; }
inline iterator end() const{ return cache.get(size()) ; }
- inline Proxy operator[]( int i ){ return cache.ref(i) ; }
- inline Proxy operator[]( int i ) const { return cache.ref(i) ; }
+ // inline Proxy operator[]( int i ){ return cache.ref(i) ; }
+ // inline Proxy operator[]( int i ) const { return cache.ref(i) ; }
+
+ inline Proxy operator[]( int i ){ return iter_first[i] ; }
+ inline Proxy operator[]( int i ) const { return iter_first[i] ; }
inline Proxy operator()( const size_t& i) throw(index_out_of_bounds){
return cache.ref( offset(i) ) ;
}
@@ -417,6 +420,7 @@
void update_vector(){
RCPP_DEBUG_1( "update_vector, VECTOR = %s", DEMANGLE(Vector) ) ;
cache.update(*this) ;
+ iter_first = cache.get() ;
}
static Vector create(){
@@ -699,6 +703,7 @@
}
traits::r_vector_cache<RTYPE> cache ;
+ iterator iter_first ;
public:
@@ -713,7 +718,6 @@
if( !::Rf_isMatrix(RObject::m_sexp) ) throw not_a_matrix() ;
return INTEGER( ::Rf_getAttrib( RObject::m_sexp, ::Rf_install( "dim") ) ) ;
}
-
} ; /* Vector */
Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/inst/include/RcppCommon.h 2010-09-25 07:05:57 UTC (rev 2168)
@@ -120,6 +120,8 @@
#include <Rcpp/internal/posixt.h>
+RcppExport void init_Rcpp_routines(DllInfo*) ;
+
namespace Rcpp{
namespace internal{
template <typename T> int rcpp_call_test(T t){
@@ -278,4 +280,6 @@
#include <Rcpp/sugar/sugar_forward.h>
+#include <Rcpp/routines.h>
+
#endif
Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/src/Module.cpp 2010-09-25 07:05:57 UTC (rev 2168)
@@ -183,6 +183,7 @@
void setCurrentScope( Rcpp::Module* scope ){ Rcpp::current_scope = scope ; }
void R_init_Rcpp( DllInfo* info){
Rcpp::current_scope = 0 ;
+ init_Rcpp_routines(info) ;
}
namespace Rcpp{
Modified: pkg/Rcpp/src/RcppCommon.cpp
===================================================================
--- pkg/Rcpp/src/RcppCommon.cpp 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/src/RcppCommon.cpp 2010-09-25 07:05:57 UTC (rev 2168)
@@ -136,10 +136,6 @@
}
}
-extern "C" void R_init_Rcpp(DllInfo* info){
- // initUncaughtExceptionHandler() ;
-}
-
namespace Rcpp{
namespace internal{
Modified: pkg/Rcpp/src/Rcpp_init.c
===================================================================
--- pkg/Rcpp/src/Rcpp_init.c 2010-09-25 00:15:42 UTC (rev 2167)
+++ pkg/Rcpp/src/Rcpp_init.c 2010-09-25 07:05:57 UTC (rev 2168)
@@ -23,26 +23,27 @@
#include <Rinternals.h>
#include <R_ext/Rdynload.h>
-SEXP CppField__get(SEXP, SEXP, SEXP);
-SEXP CppField__set(SEXP, SEXP, SEXP, SEXP);
+#include <Rcpp/routines.h>
-
+// TODO: check that having this static does not mess up with
+// RInside, and move it within init_Rcpp_routines otherwise
static R_CallMethodDef callEntries[] = {
{"CppField__get", (DL_FUNC) &CppField__get, 3},
- {"CppField__set", (DL_FUNC) &CppField__set, 4},
- {NULL, NULL, 0}
- };
-
-void
-R_init_SoDA(DllInfo *info)
-{
+ {"CppField__set", (DL_FUNC) &CppField__set, 4},
+ {NULL, NULL, 0}
+};
+
+// this is called by R_init_Rcpp that is in Module.cpp
+void init_Rcpp_routines(DllInfo *info){
/* Register routines, allocate resources. */
- R_registerRoutines(info, NULL /* .C*/, callEntries /*.Call*/,
- NULL /* .Fortran */, NULL /*.Extern*/);
+ R_registerRoutines(info,
+ NULL /* .C*/,
+ callEntries /*.Call*/,
+ NULL /* .Fortran */,
+ NULL /*.Extern*/
+ );
}
-void
-R_unload_SoDA(DllInfo *info)
-{
+void R_unload_Rcpp(DllInfo *info) {
/* Release resources. */
}
More information about the Rcpp-commits
mailing list