[Rcpp-commits] r3612 - in pkg/Rcpp: R inst/skeleton
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu May 24 17:15:55 CEST 2012
Author: edd
Date: 2012-05-24 17:15:55 +0200 (Thu, 24 May 2012)
New Revision: 3612
Added:
pkg/Rcpp/inst/skeleton/Num.cpp
pkg/Rcpp/inst/skeleton/stdVector.cpp
Modified:
pkg/Rcpp/R/Rcpp.package.skeleton.R
Log:
Rcpp.package.skeleton() with module=TRUE now copies two more C++ source files
added two source files from regression test example for Rcpp Modules
Modified: pkg/Rcpp/R/Rcpp.package.skeleton.R
===================================================================
--- pkg/Rcpp/R/Rcpp.package.skeleton.R 2012-05-24 13:51:13 UTC (rev 3611)
+++ pkg/Rcpp/R/Rcpp.package.skeleton.R 2012-05-24 15:15:55 UTC (rev 3612)
@@ -1,4 +1,4 @@
-# Copyright (C) 2009 - 2011 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2009 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -17,18 +17,18 @@
Rcpp.package.skeleton <- function(
name = "anRpackage", list = character(), environment = .GlobalEnv,
- path = ".", force = FALSE, namespace = TRUE,
- code_files = character(),
- example_code = TRUE,
- module = FALSE,
- author = "Who wrote it",
- maintainer = if(missing( author)) "Who to complain to" else author,
- email = "yourfault at somewhere.net",
+ path = ".", force = FALSE, namespace = TRUE,
+ code_files = character(),
+ example_code = TRUE,
+ module = FALSE,
+ author = "Who wrote it",
+ maintainer = if(missing( author)) "Who to complain to" else author,
+ email = "yourfault at somewhere.net",
license = "What Licence is it under ?"
){
-
+
env <- parent.frame(1)
-
+
if( !length(list) ){
fake <- TRUE
assign( "Rcpp.fake.fun", function(){}, envir = env )
@@ -36,7 +36,7 @@
assign( "rcpp_hello_world", function(){}, envir = env )
remove_hello_world <- TRUE
} else {
- remove_hello_world <- FALSE
+ remove_hello_world <- FALSE
}
} else {
if( ! "rcpp_hello_world" %in% list ){
@@ -47,41 +47,41 @@
}
fake <- FALSE
}
-
+
# first let the traditional version do its business
call <- match.call()
call[[1]] <- as.name("package.skeleton")
call[["namespace"]] <- namespace
# remove Rcpp specific arguments
-
+
call <- call[ c( 1L, which( names(call) %in% names(formals(package.skeleton)))) ]
-
+
if( fake ){
call[["list"]] <- c( if( isTRUE(example_code)) "rcpp_hello_world" , "Rcpp.fake.fun" )
}
-
+
tryCatch( eval( call, envir = env ), error = function(e){
stop( sprintf( "error while calling `package.skeleton` : %s", conditionMessage(e) ) )
} )
-
+
message( "\nAdding Rcpp settings" )
-
- # now pick things up
+
+ # now pick things up
root <- file.path( path, name )
-
+
# Add Rcpp to the DESCRIPTION
DESCRIPTION <- file.path( root, "DESCRIPTION" )
if( file.exists( DESCRIPTION ) ){
- depends <- c(
- if( isTRUE(module) ) "methods",
+ depends <- c(
+ if( isTRUE(module) ) "methods",
sprintf( "Rcpp (>= %s)", packageDescription("Rcpp")[["Version"]] )
- )
- x <- cbind( read.dcf( DESCRIPTION ),
- "Depends" = paste( depends, collapse = ", ") ,
+ )
+ x <- cbind( read.dcf( DESCRIPTION ),
+ "Depends" = paste( depends, collapse = ", ") ,
"LinkingTo" = "Rcpp"
)
if( isTRUE( module ) ){
- x <- cbind( x, "RcppModules" = "yada" )
+ x <- cbind( x, "RcppModules" = "yada, stdVector, NumEx" )
message( " >> added RcppModules: yada" )
}
x[, "Author" ] <- author
@@ -90,9 +90,9 @@
message( " >> added Depends: Rcpp" )
message( " >> added LinkingTo: Rcpp" )
write.dcf( x, file = DESCRIPTION )
-
+
}
-
+
# if there is a NAMESPACE, add a useDynLib
NAMESPACE <- file.path( root, "NAMESPACE")
if( file.exists( NAMESPACE ) ){
@@ -103,13 +103,13 @@
writeLines( lines, con = ns )
message( " >> added useDynLib directive to NAMESPACE" )
}
-
+
if(isTRUE(module)){
writeLines( 'import( Rcpp )', ns )
}
close( ns )
}
-
+
# lay things out in the src directory
src <- file.path( root, "src")
if( !file.exists( src )){
@@ -121,70 +121,66 @@
file.copy( file.path( skeleton, "Makevars" ), Makevars )
message( " >> added Makevars file with Rcpp settings" )
}
-
+
Makevars.win <- file.path( src, "Makevars.win" )
if( !file.exists( Makevars.win ) ){
file.copy( file.path( skeleton, "Makevars.win" ), Makevars.win )
message( " >> added Makevars.win file with Rcpp settings" )
}
-
+
if( example_code ){
header <- readLines( file.path( skeleton, "rcpp_hello_world.h" ) )
header <- gsub( "@PKG@", name, header, fixed = TRUE )
writeLines( header , file.path( src, "rcpp_hello_world.h" ) )
message( " >> added example header file using Rcpp classes")
-
+
file.copy( file.path( skeleton, "rcpp_hello_world.cpp" ), src )
message( " >> added example src file using Rcpp classes")
-
+
rcode <- readLines( file.path( skeleton, "rcpp_hello_world.R" ) )
rcode <- gsub( "@PKG@", name, rcode, fixed = TRUE )
writeLines( rcode , file.path( root, "R", "rcpp_hello_world.R" ) )
message( " >> added example R file calling the C++ example")
-
+
hello.Rd <- file.path( root, "man", "rcpp_hello_world.Rd")
unlink( hello.Rd )
- file.copy(
- system.file("skeleton", "rcpp_hello_world.Rd", package = "Rcpp" ),
+ file.copy(
+ system.file("skeleton", "rcpp_hello_world.Rd", package = "Rcpp" ),
hello.Rd
)
message( " >> added Rd file for rcpp_hello_world")
-
+
}
-
+
if( isTRUE( module ) ){
- file.copy(
- system.file( "skeleton", "rcpp_module.cpp", package = "Rcpp" ),
- file.path( root, "src" )
- )
- file.copy(
- system.file( "skeleton", "zzz.R", package = "Rcpp" ),
- file.path( root, "R" )
- )
+ file.copy(system.file( "skeleton", "rcpp_module.cpp", package = "Rcpp" ), file.path( root, "src" ))
+ file.copy(system.file( "skeleton", "Num.cpp", package = "Rcpp" ), file.path( root, "src" ))
+ file.copy(system.file( "skeleton", "stdVector.cpp", package = "Rcpp" ), file.path( root, "src" ))
+ file.copy(system.file( "skeleton", "zzz.R", package = "Rcpp" ), file.path( root, "R" ))
message( " >> copied the example module " )
-
+
}
-
+
lines <- readLines( package.doc <- file.path( root, "man", sprintf( "%s-package.Rd", name ) ) )
lines <- sub( "~~ simple examples", "%% ~~ simple examples", lines )
-
+
lines <- lines[ !grepl( "~~ package title", lines) ]
lines <- lines[ !grepl( "~~ The author and", lines) ]
lines <- sub( "Who wrote it", author, lines )
lines <- sub( "Who to complain to.*", sprintf( "%s <%s>", maintainer, email), lines )
-
+
writeLines( lines, package.doc )
-
+
if( fake ){
rm( "Rcpp.fake.fun", envir = env )
unlink( file.path( root, "R" , "Rcpp.fake.fun.R" ) )
unlink( file.path( root, "man", "Rcpp.fake.fun.Rd" ) )
}
-
+
if( isTRUE(remove_hello_world) ){
rm( "rcpp_hello_world", envir = env )
}
-
+
invisible( NULL )
}
Added: pkg/Rcpp/inst/skeleton/Num.cpp
===================================================================
--- pkg/Rcpp/inst/skeleton/Num.cpp (rev 0)
+++ pkg/Rcpp/inst/skeleton/Num.cpp 2012-05-24 15:15:55 UTC (rev 3612)
@@ -0,0 +1,51 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// Num.cpp: Rcpp R/C++ interface class library -- Rcpp Module example
+//
+// Copyright (C) 2010 - 2012 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/>.
+
+#include <Rcpp.h>
+
+class Num { // simple class with two private variables
+public: // which have a getter/setter and getter
+ 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" )
+
+ .default_constructor()
+
+ // read and write property
+ .property( "x", &Num::getX, &Num::setX )
+
+ // read-only property
+ .property( "y", &Num::getY )
+ ;
+}
Added: pkg/Rcpp/inst/skeleton/stdVector.cpp
===================================================================
--- pkg/Rcpp/inst/skeleton/stdVector.cpp (rev 0)
+++ pkg/Rcpp/inst/skeleton/stdVector.cpp 2012-05-24 15:15:55 UTC (rev 3612)
@@ -0,0 +1,90 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// stdVector.cpp: Rcpp R/C++ interface class library -- Rcpp Module class example
+//
+// Copyright (C) 2010 - 2012 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/>.
+
+#include <Rcpp.h> // need to include the main Rcpp header file only
+
+// 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;
+}
+
+void vec_resize( vec* obj, int n) { obj->resize( n ); }
+void vec_push_back( vec* obj, double x ) { obj->push_back( x ); }
+
+// Wrappers for member functions that return a reference
+// Required on Solaris
+double vec_back(vec *obj){ return obj->back() ; }
+double vec_front(vec *obj){ return obj->front() ; }
+double vec_at(vec *obj, int i){ return obj->at(i) ; }
+
+RCPP_MODULE(stdVector){
+ using namespace Rcpp ;
+
+ // we expose the class std::vector<double> as "vec" on the R side
+ class_<vec>("vec")
+
+ // exposing the default constructor
+ .constructor()
+
+ // exposing member functions -- taken directly from std::vector<double>
+ .method( "size", &vec::size)
+ .method( "max_size", &vec::max_size)
+ .method( "capacity", &vec::capacity)
+ .method( "empty", &vec::empty)
+ .method( "reserve", &vec::reserve)
+ .method( "pop_back", &vec::pop_back )
+ .method( "clear", &vec::clear )
+
+ // specifically exposing const member functions defined above
+ .method( "back", &vec_back )
+ .method( "front", &vec_front )
+ .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 )
+ .method( "push_back",&vec_push_back )
+ .method( "resize", &vec_resize)
+
+ // special methods for indexing
+ .method( "[[", &vec_at )
+ .method( "[[<-", &vec_set )
+
+ ;
+}
More information about the Rcpp-commits
mailing list