[Rcpp-commits] r2097 - in pkg/Rcpp/inst/unitTests: . testRcppModule testRcppModule/R testRcppModule/man testRcppModule/src testRcppModule/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 10 13:43:00 CEST 2010
Author: romain
Date: 2010-09-10 13:43:00 +0200 (Fri, 10 Sep 2010)
New Revision: 2097
Added:
pkg/Rcpp/inst/unitTests/runit.Module.client.package.R
pkg/Rcpp/inst/unitTests/testRcppModule/
pkg/Rcpp/inst/unitTests/testRcppModule/DESCRIPTION
pkg/Rcpp/inst/unitTests/testRcppModule/NAMESPACE
pkg/Rcpp/inst/unitTests/testRcppModule/R/
pkg/Rcpp/inst/unitTests/testRcppModule/R/Modules.R
pkg/Rcpp/inst/unitTests/testRcppModule/R/rcpp_hello_world.R
pkg/Rcpp/inst/unitTests/testRcppModule/man/
pkg/Rcpp/inst/unitTests/testRcppModule/man/rcpp_hello_world.Rd
pkg/Rcpp/inst/unitTests/testRcppModule/man/testRcppModule-package.Rd
pkg/Rcpp/inst/unitTests/testRcppModule/man/yada.Rd
pkg/Rcpp/inst/unitTests/testRcppModule/src/
pkg/Rcpp/inst/unitTests/testRcppModule/src/Makevars
pkg/Rcpp/inst/unitTests/testRcppModule/src/Makevars.win
pkg/Rcpp/inst/unitTests/testRcppModule/src/Num.cpp
pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_hello_world.cpp
pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_hello_world.h
pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_module.cpp
pkg/Rcpp/inst/unitTests/testRcppModule/src/stdVector.cpp
pkg/Rcpp/inst/unitTests/testRcppModule/tests/
pkg/Rcpp/inst/unitTests/testRcppModule/tests/modules.R
Modified:
pkg/Rcpp/inst/unitTests/runit.Module.R
Log:
added John's testRcppModule package as part of Rcpp unit tests
Modified: pkg/Rcpp/inst/unitTests/runit.Module.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.R 2010-09-10 11:01:00 UTC (rev 2096)
+++ pkg/Rcpp/inst/unitTests/runit.Module.R 2010-09-10 11:43:00 UTC (rev 2097)
@@ -251,6 +251,5 @@
checkException( { w$y <- 3 } )
}
-
-
+
}
Added: pkg/Rcpp/inst/unitTests/runit.Module.client.package.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.client.package.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.Module.client.package.R 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,71 @@
+#!/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/>.
+
+.tearDown <- function(){
+ gc()
+}
+
+if( Rcpp:::capabilities()[["Rcpp modules"]] ) {
+
+test.Module.package <- function( ){
+
+ td <- tempfile()
+ cwd <- getwd()
+ dir.create( td )
+ file.copy( system.file( "unitTests", "testRcppModule", package = "Rcpp" ) , td, recursive = TRUE)
+ setwd( td )
+ on.exit( { setwd( cwd) ; unlink( td, recursive = TRUE ) } )
+ R <- shQuote( file.path( R.home( component = "bin" ), "R" ))
+ cmd <- paste( R , "CMD build testRcppModule" )
+ system( cmd )
+ dir.create( "templib" )
+ install.packages( "testRcppModule_0.1.tar.gz", "templib", repos = NULL, type = "source" )
+ require( "testRcppModule", "templib", character.only = TRUE )
+
+ vClass <- stdVector$vec
+ vec <- new(vClass)
+
+ data <- 1:10
+ vec$assign(data)
+ vec[[3]] <- vec[[3]] + 1
+
+ data[[4]] <- data[[4]] +1
+
+ checkEquals( vec$as.vector(), data )
+
+ ## a few function calls
+
+ checkEquals( yada$bar(2), 4)
+
+ e <- tryCatch(yada$hello(), error = function(x)x)
+
+ checkTrue(is(e, "error"))
+ checkEquals( e$message, "boom")
+
+ checkEquals( yada$foo(2,3), 6)
+
+ ## properties (at one stage this seqfaulted, so beware)
+ nc = NumEx$Num
+ nn <- new(nc)
+ nn$x <- pi
+ checkEquals( nn$x, pi )
+
+}
+
+}
Added: pkg/Rcpp/inst/unitTests/testRcppModule/DESCRIPTION
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/DESCRIPTION (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/DESCRIPTION 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,14 @@
+Package: testRcppModule
+Type: Package
+Title: Some test examples using Rcpp with the Module feature
+Version: 0.1
+Date: 2010-09-06
+Author: JMC
+Maintainer: <jmc at stat.stanford.edu>
+Description: Some examples taken (and perhaps modified) from the Rcpp Modules documentation.
+License: GPL(>=2)
+LazyLoad: yes
+Depends: methods, Rcpp (>= 0.8.5)
+LinkingTo: Rcpp
+SystemRequirements: GNU make
+Packaged: 2010-09-09 18:42:28 UTC; jmc
Added: pkg/Rcpp/inst/unitTests/testRcppModule/NAMESPACE
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/NAMESPACE (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/NAMESPACE 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,3 @@
+useDynLib(testRcppModule)
+exportPattern("^[[:alpha:]]+")
+importClassesFrom( Rcpp, "C++Object", "C++Class", "Module" )
Added: pkg/Rcpp/inst/unitTests/testRcppModule/R/Modules.R
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/R/Modules.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/R/Modules.R 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,6 @@
+
+## create modules (their pointers will be initialized when first used)
+yada <- Module("yada")
+stdVector <- Module("stdVector")
+NumEx <- Module("NumEx")
+
Added: pkg/Rcpp/inst/unitTests/testRcppModule/R/rcpp_hello_world.R
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/R/rcpp_hello_world.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/R/rcpp_hello_world.R 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,5 @@
+
+rcpp_hello_world <- function(){
+ .Call( "rcpp_hello_world", PACKAGE = "testRcppModule" )
+}
+
Added: pkg/Rcpp/inst/unitTests/testRcppModule/man/rcpp_hello_world.Rd
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/man/rcpp_hello_world.Rd (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/man/rcpp_hello_world.Rd 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,17 @@
+\name{rcpp_hello_world}
+\alias{rcpp_hello_world}
+\docType{package}
+\title{
+Simple function using Rcpp
+}
+\description{
+Simple function using Rcpp
+}
+\usage{
+rcpp_hello_world()
+}
+\examples{
+\dontrun{
+rcpp_hello_world()
+}
+}
Added: pkg/Rcpp/inst/unitTests/testRcppModule/man/testRcppModule-package.Rd
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/man/testRcppModule-package.Rd (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/man/testRcppModule-package.Rd 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,43 @@
+\name{testRcppModule-package}
+\alias{testRcppModule-package}
+\alias{testRcppModule}
+\docType{package}
+\title{
+What the package does (short line)
+~~ package title ~~
+}
+\description{
+More about what it does (maybe more than one line)
+~~ A concise (1-5 lines) description of the package ~~
+}
+\details{
+\tabular{ll}{
+Package: \tab testRcppModule\cr
+Type: \tab Package\cr
+Version: \tab 1.0\cr
+Date: \tab 2010-09-06\cr
+License: \tab What license is it under?\cr
+LazyLoad: \tab yes\cr
+}
+~~ An overview of how to use the package, including the most important ~~
+~~ functions ~~
+}
+\author{
+Who wrote it
+
+Maintainer: Who to complain to <yourfault at somewhere.net>
+~~ The author and/or maintainer of the package ~~
+}
+\references{
+~~ Literature or other references for background information ~~
+}
+~~ Optionally other standard keywords, one per line, from file KEYWORDS in ~~
+~~ the R documentation directory ~~
+\keyword{ package }
+\seealso{
+~~ Optional links to other man pages, e.g. ~~
+~~ \code{\link[<pkg>:<pkg>-package]{<pkg>}} ~~
+}
+\examples{
+%% ~~ simple examples of the most important functions ~~
+}
Added: pkg/Rcpp/inst/unitTests/testRcppModule/man/yada.Rd
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/man/yada.Rd (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/man/yada.Rd 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,36 @@
+\name{yada}
+\alias{yada}
+\title{
+ Rcpp module yada
+}
+\description{
+ Rcpp module yada
+}
+\details{
+ The module contains the following items:
+
+ functions: \describe{
+ \item{bar}{ ~~ description of function bar ~~ }
+ \item{bla}{ ~~ description of function bla ~~ }
+ \item{bla1}{ ~~ description of function bla1 ~~ }
+ \item{bla2}{ ~~ description of function bla2 ~~ }
+ \item{foo}{ ~~ description of function foo ~~ }
+ \item{hello}{ ~~ description of function hello ~~ }
+ }
+
+ classes: \describe{
+ \item{World}{ ~~ description of class World ~~ }
+ }
+}
+\source{
+%% ~~ reference to a publication or URL ~~
+%% ~~ perhaps a reference to the project page of the c++ code being exposed ~~
+}
+\references{
+%% ~~ possibly secondary sources and usages ~~
+%% ~~ perhaps references to the C++ code that the module exposes ~~
+}
+\examples{
+show( yada )
+}
+\keyword{datasets}
Added: pkg/Rcpp/inst/unitTests/testRcppModule/src/Makevars
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/src/Makevars (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/src/Makevars 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,27 @@
+## Use the R_HOME indirection to support installations of multiple R version
+PKG_LIBS = $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()" )
+
+## As an alternative, one can also add this code in a file 'configure'
+##
+## PKG_LIBS=`${R_HOME}/bin/Rscript -e "Rcpp:::LdFlags()"`
+##
+## sed -e "s|@PKG_LIBS@|${PKG_LIBS}|" \
+## src/Makevars.in > src/Makevars
+##
+## which together with the following file 'src/Makevars.in'
+##
+## PKG_LIBS = @PKG_LIBS@
+##
+## can be used to create src/Makevars dynamically. This scheme is more
+## powerful and can be expanded to also check for and link with other
+## libraries. It should be complemented by a file 'cleanup'
+##
+## rm src/Makevars
+##
+## which removes the autogenerated file src/Makevars.
+##
+## Of course, autoconf can also be used to write configure files. This is
+## done by a number of packages, but recommended only for more advanced users
+## comfortable with autoconf and its related tools.
+
+
Added: pkg/Rcpp/inst/unitTests/testRcppModule/src/Makevars.win
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/src/Makevars.win (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/src/Makevars.win 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,4 @@
+
+## Use the R_HOME indirection to support installations of multiple R version
+PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()")
+
Added: pkg/Rcpp/inst/unitTests/testRcppModule/src/Num.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/src/Num.cpp (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/src/Num.cpp 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,28 @@
+#include "rcpp_hello_world.h"
+
+class Num{
+public:
+ Num() : x(0.0), y(0){} ;
+
+ double getX() { return x ; }
+ void setX(double value){ x = value ; }
+
+ int getY() { return y ; }
+
+private:
+ double x ;
+ int y ;
+};
+
+RCPP_MODULE(NumEx){
+ using namespace Rcpp ;
+
+ class_<Num>( "Num" )
+
+ // read and write property
+ .property( "x", &Num::getX, &Num::setX )
+
+ // read-only property
+ .property( "y", &Num::getY )
+ ;
+}
Added: pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_hello_world.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_hello_world.cpp (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_hello_world.cpp 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,11 @@
+#include "rcpp_hello_world.h"
+
+SEXP rcpp_hello_world(){
+ using namespace Rcpp ;
+
+ CharacterVector x = CharacterVector::create( "foo", "bar" ) ;
+ NumericVector y = NumericVector::create( 0.0, 1.0 ) ;
+ List z = List::create( x, y ) ;
+
+ return z ;
+}
Added: pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_hello_world.h
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_hello_world.h (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_hello_world.h 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,8 @@
+#ifndef _testRcppModule_RCPP_HELLO_WORLD_H
+#define _testRcppModule_RCPP_HELLO_WORLD_H
+
+#include <Rcpp.h>
+
+RcppExport SEXP rcpp_hello_world() ;
+
+#endif
Added: pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_module.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_module.cpp (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/src/rcpp_module.cpp 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,55 @@
+#include <Rcpp.h>
+
+std::string hello() {
+ throw std::range_error( "boom" ) ;
+}
+
+int bar( int x){
+ return x*2 ;
+}
+
+double foo( int x, double y){
+ return x * y ;
+}
+
+void bla( ){
+ Rprintf( "hello\\n" ) ;
+}
+
+void bla1( int x){
+ Rprintf( "hello (x = %d)\\n", x ) ;
+}
+
+void bla2( int x, double y){
+ Rprintf( "hello (x = %d, y = %5.2f)\\n", x, y ) ;
+}
+
+class World {
+public:
+ World() : msg("hello"){}
+ void set(std::string msg) { this->msg = msg; }
+ std::string greet() { return msg; }
+
+private:
+ std::string msg;
+};
+
+
+
+RCPP_MODULE(yada){
+ using namespace Rcpp ;
+
+ function( "hello" , &hello ) ;
+ function( "bar" , &bar ) ;
+ function( "foo" , &foo ) ;
+ function( "bla" , &bla ) ;
+ function( "bla1" , &bla1 ) ;
+ function( "bla2" , &bla2 ) ;
+
+ class_<World>( "World" )
+ .method( "greet", &World::greet )
+ .method( "set", &World::set )
+ ;
+}
+
+
Added: pkg/Rcpp/inst/unitTests/testRcppModule/src/stdVector.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/src/stdVector.cpp (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/src/stdVector.cpp 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,57 @@
+#include "rcpp_hello_world.h"
+
+// convenience typedef
+typedef std::vector<double> vec ;
+
+// helpers
+void vec_assign( vec* obj, Rcpp::NumericVector data ){
+ obj->assign( data.begin(), data.end() ) ;
+}
+
+void vec_insert( vec* obj, int position, Rcpp::NumericVector data){
+ vec::iterator it = obj->begin() + position ;
+ obj->insert( it, data.begin(), data.end() ) ;
+}
+
+Rcpp::NumericVector vec_asR( vec* obj ){
+ return Rcpp::wrap( *obj ) ;
+}
+
+void vec_set( vec* obj, int i, double value ){
+ obj->at( i ) = value ;
+}
+
+RCPP_MODULE(stdVector){
+ using namespace Rcpp ;
+
+ // we expose the class std::vector<double> as "vec" on the R side
+ class_<vec>( "vec")
+
+ // exposing member functions
+ .method( "size", &vec::size)
+ .method( "max_size", &vec::max_size)
+ .method( "resize", &vec::resize)
+ .method( "capacity", &vec::capacity)
+ .method( "empty", &vec::empty)
+ .method( "reserve", &vec::reserve)
+ .method( "push_back", &vec::push_back )
+ .method( "pop_back", &vec::pop_back )
+ .method( "clear", &vec::clear )
+
+ // specifically exposing const member functions
+ .const_method( "back", &vec::back )
+ .const_method( "front", &vec::front )
+ .const_method( "at", &vec::at )
+
+ // exposing free functions taking a std::vector<double>*
+ // as their first argument
+ .method( "assign", &vec_assign )
+ .method( "insert", &vec_insert )
+ .method( "as.vector", &vec_asR )
+
+ // special methods for indexing
+ .const_method( "[[", &vec::at )
+ .method( "[[<-", &vec_set )
+
+ ;
+}
Added: pkg/Rcpp/inst/unitTests/testRcppModule/tests/modules.R
===================================================================
--- pkg/Rcpp/inst/unitTests/testRcppModule/tests/modules.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/testRcppModule/tests/modules.R 2010-09-10 11:43:00 UTC (rev 2097)
@@ -0,0 +1,30 @@
+library(testRcppModule)
+vClass <- stdVector$vec
+vec <- new(vClass)
+
+data <- 1:10
+vec$assign(data)
+vec[[3]] <- vec[[3]] + 1
+
+data[[4]] <- data[[4]] +1
+
+stopifnot(identical(all.equal(vec$as.vector(), data), TRUE))
+
+## a few function calls
+
+stopifnot(all.equal(yada$bar(2), 4))
+
+e <- tryCatch(yada$hello(), error = function(x)x)
+
+stopifnot(is(e, "error"), all.equal(e$message, "boom"))
+
+stopifnot(all.equal(yada$foo(2,3), 6))
+
+## properties (at one stage this seqfaulted, so beware)
+nc = NumEx$Num
+nn <- new(nc)
+nn$x <- pi
+stopifnot(all.equal(nn$x, pi))
+
+
+
More information about the Rcpp-commits
mailing list