[Rcpp-commits] r4394 - in pkg/Rcpp: . inst inst/include inst/include/Rcpp inst/include/Rcpp/api/meat inst/include/Rcpp/vector inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 17 12:02:17 CEST 2013
Author: romain
Date: 2013-07-17 12:02:17 +0200 (Wed, 17 Jul 2013)
New Revision: 4394
Added:
pkg/Rcpp/inst/include/Rcpp/api/meat/is.h
pkg/Rcpp/inst/include/Rcpp/is.h
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/NEWS.Rd
pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h
pkg/Rcpp/inst/include/Rcpp/vector/instantiation.h
pkg/Rcpp/inst/include/RcppCommon.h
pkg/Rcpp/inst/unitTests/runit.Date.R
pkg/Rcpp/inst/unitTests/runit.S4.R
pkg/Rcpp/inst/unitTests/runit.String.R
pkg/Rcpp/inst/unitTests/runit.Vector.R
pkg/Rcpp/inst/unitTests/runit.wstring.R
Log:
first pass at implementing Rcpp::is<T>
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/ChangeLog 2013-07-17 10:02:17 UTC (rev 4394)
@@ -1,3 +1,9 @@
+2013-07-17 Romain Francois <romain at r-enthusiasts.com>
+
+ * include/Rcpp/vector/instantiation.h: added the DoubleVector alias
+ to NumericVector
+ * include/Rcpp/is.h: added is template function
+
2013-07-11 Dirk Eddelbuettel <edd at debian.org>
* R/Attributes.R: Add an OpenMP plugin
Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/NEWS.Rd 2013-07-17 10:02:17 UTC (rev 4394)
@@ -12,6 +12,12 @@
stack traces.
\item \code{as<T&>} and \code{as<const T&>} is now supported, when
T is a class exposed by modules, i.e. with \code{RCPP_EXPOSED_CLASS}
+ \item \code{DoubleVector} as been added as an alias to
+ \code{NumericVector}
+ \item New template function \code{is<T>} to identify if an R object
+ can be seen as a \code{T}. For example \code{is<DataFrame>(x)}.
+ This is a building block for more expressive dispatch in various places
+ (modules and attributes functions).
}
\item Changes in Attributes:
Added: pkg/Rcpp/inst/include/Rcpp/api/meat/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/api/meat/is.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/api/meat/is.h 2013-07-17 10:02:17 UTC (rev 4394)
@@ -0,0 +1,143 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// is.h: Rcpp R/C++ interface class library -- is implementations
+//
+// Copyright (C) 2013 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_api_meat_is_h
+#define Rcpp_api_meat_is_h
+
+namespace Rcpp{
+
+ inline bool is_atomic( SEXP x){ return Rf_length(x) == 1 ; }
+ inline bool is_matrix(SEXP x){
+ SEXP dim = Rf_getAttrib( x, R_DimSymbol) ;
+ return dim != R_NilValue && Rf_length(dim) == 2 ;
+ }
+
+ template <> inline bool is<int>( SEXP x ){
+ return is_atomic(x) && TYPEOF(x) == INTSXP ;
+ }
+
+ template <> inline bool is<double>( SEXP x ){
+ return is_atomic(x) && TYPEOF(x) == REALSXP ;
+ }
+
+ template <> inline bool is<bool>( SEXP x ){
+ return is_atomic(x) && TYPEOF(x) == LGLSXP ;
+ }
+
+ template <> inline bool is<std::string>( SEXP x ){
+ return is_atomic(x) && TYPEOF(x) == STRSXP ;
+ }
+
+ template <> inline bool is<String>( SEXP x ){
+ return is_atomic(x) && TYPEOF(x) == STRSXP ;
+ }
+
+ template <> inline bool is<RObject>( SEXP x ){
+ return true ;
+ }
+ template <> inline bool is<IntegerVector>( SEXP x ){
+ return TYPEOF(x) == INTSXP ;
+ }
+ template <> inline bool is<ComplexVector>( SEXP x ){
+ return TYPEOF(x) == CPLXSXP ;
+ }
+ template <> inline bool is<RawVector>( SEXP x ){
+ return TYPEOF(x) == RAWSXP ;
+ }
+ template <> inline bool is<NumericVector>( SEXP x ){
+ return TYPEOF(x) == REALSXP ;
+ }
+ template <> inline bool is<LogicalVector>( SEXP x ){
+ return TYPEOF(x) == LGLSXP ;
+ }
+ template <> inline bool is<List>( SEXP x ){
+ return TYPEOF(x) == VECSXP ;
+ }
+ template <> inline bool is<IntegerMatrix>( SEXP x ){
+ return TYPEOF(x) == INTSXP && is_matrix(x) ;
+ }
+ template <> inline bool is<ComplexMatrix>( SEXP x ){
+ return TYPEOF(x) == CPLXSXP && is_matrix(x) ;
+ }
+ template <> inline bool is<RawMatrix>( SEXP x ){
+ return TYPEOF(x) == RAWSXP && is_matrix(x) ;
+ }
+ template <> inline bool is<NumericMatrix>( SEXP x ){
+ return TYPEOF(x) == REALSXP && is_matrix(x) ;
+ }
+ template <> inline bool is<LogicalMatrix>( SEXP x ){
+ return TYPEOF(x) == LGLSXP && is_matrix(x) ;
+ }
+ template <> inline bool is<GenericMatrix>( SEXP x ){
+ return TYPEOF(x) == VECSXP && is_matrix(x) ;
+ }
+
+
+ template <> inline bool is<DataFrame>( SEXP x ){
+ if( TYPEOF(x) != VECSXP ) return false ;
+ return Rf_inherits( x, "data.frame" ) ;
+ }
+ template <> inline bool is<WeakReference>( SEXP x ){
+ return TYPEOF(x) == WEAKREFSXP ;
+ }
+ template <> inline bool is<Symbol>( SEXP x ){
+ return TYPEOF(x) == SYMSXP ;
+ }
+ template <> inline bool is<S4>( SEXP x ){
+ return ::Rf_isS4(x);
+ }
+ template <> inline bool is<Reference>( SEXP x ){
+ if( ! ::Rf_isS4(x) ) return false ;
+ return ::Rf_inherits(x, "envRefClass" ) ;
+ }
+ template <> inline bool is<Promise>( SEXP x ){
+ return TYPEOF(x) == PROMSXP ;
+ }
+ template <> inline bool is<Pairlist>( SEXP x ){
+ return TYPEOF(x) == LISTSXP ;
+ }
+ template <> inline bool is<Function>( SEXP x ){
+ return TYPEOF(x) == CLOSXP || TYPEOF(x) == SPECIALSXP || TYPEOF(x) == BUILTINSXP ;
+ }
+ template <> inline bool is<Environment>( SEXP x ){
+ return TYPEOF(x) == ENVSXP ;
+ }
+ template <> inline bool is<Formula>( SEXP x ){
+ if( TYPEOF(x) != LANGSXP ) return false ;
+ return Rf_inherits( x, "formula" ) ;
+ }
+
+ template <> inline bool is<Date>( SEXP x ){
+ return is_atomic(x) && TYPEOF(x) == REALSXP && Rf_inherits( x, "Date" ) ;
+ }
+ template <> inline bool is<Datetime>( SEXP x ){
+ return is_atomic(x) && TYPEOF(x) == REALSXP && Rf_inherits( x, "POSIXt" ) ;
+ }
+ template <> inline bool is<DateVector>( SEXP x ){
+ return TYPEOF(x) == REALSXP && Rf_inherits( x, "Date" ) ;
+ }
+ template <> inline bool is<DatetimeVector>( SEXP x ){
+ return TYPEOF(x) == REALSXP && Rf_inherits( x, "POSIXt" ) ;
+ }
+
+} // namespace Rcpp
+
+#endif
Modified: pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h 2013-07-17 10:02:17 UTC (rev 4394)
@@ -28,5 +28,6 @@
#include <Rcpp/api/meat/Vector.h>
#include <Rcpp/api/meat/Matrix.h>
#include <Rcpp/api/meat/Reference.h>
+#include <Rcpp/api/meat/is.h>
#endif
Added: pkg/Rcpp/inst/include/Rcpp/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/is.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/is.h 2013-07-17 10:02:17 UTC (rev 4394)
@@ -0,0 +1,37 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// is.h: Rcpp R/C++ interface class library -- test if an R Object can be seen
+// as one type
+//
+// Copyright (C) 2013 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__is__h
+#define Rcpp__is__h
+
+namespace Rcpp{
+
+ /** identify if an x can be seen as the T type
+ *
+ * example:
+ * bool is_list = is<List>( x ) ;
+ */
+ template <typename T> bool is( SEXP x ) ;
+
+} // Rcpp
+
+#endif
Modified: pkg/Rcpp/inst/include/Rcpp/vector/instantiation.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/instantiation.h 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/include/Rcpp/vector/instantiation.h 2013-07-17 10:02:17 UTC (rev 4394)
@@ -2,7 +2,7 @@
//
// instantiation.h: Rcpp R/C++ interface class library --
//
-// Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2010 - 2013 Dirk Eddelbuettel and Romain Francois
//
// This file is part of Rcpp.
//
@@ -26,6 +26,7 @@
typedef Vector<INTSXP> IntegerVector ;
typedef Vector<LGLSXP> LogicalVector ;
typedef Vector<REALSXP> NumericVector ;
+typedef Vector<REALSXP> DoubleVector ;
typedef Vector<RAWSXP> RawVector ;
typedef Vector<STRSXP> CharacterVector ;
Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/include/RcppCommon.h 2013-07-17 10:02:17 UTC (rev 4394)
@@ -110,6 +110,7 @@
#include <Rcpp/internal/export.h>
#include <Rcpp/internal/r_coerce.h>
#include <Rcpp/as.h>
+#include <Rcpp/is.h>
#include <Rcpp/vector/VectorBase.h>
#include <Rcpp/vector/MatrixBase.h>
Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R 2013-07-17 10:02:17 UTC (rev 4394)
@@ -22,10 +22,7 @@
if (.runThisTest) {
-.setUp <- function(){
- if (!exists("pathRcppTests")) pathRcppTests <- getwd()
- sourceCpp(file.path(pathRcppTests, "cpp/dates.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup("dates.cpp")
test.Date.ctor.sexp <- function() {
fun <- ctor_sexp
Modified: pkg/Rcpp/inst/unitTests/runit.S4.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.S4.R 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.S4.R 2013-07-17 10:02:17 UTC (rev 4394)
@@ -21,9 +21,7 @@
if (.runThisTest) {
-.setUp <- function() {
- sourceCpp(file.path(pathRcppTests, "cpp/S4.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "S4.cpp" )
test.RObject.S4methods <- function(){
setClass("track", representation(x="numeric", y="numeric"))
Modified: pkg/Rcpp/inst/unitTests/runit.String.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.String.R 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.String.R 2013-07-17 10:02:17 UTC (rev 4394)
@@ -22,10 +22,7 @@
if (.runThisTest) {
-.setUp <- function(){
- #sourceCpp( system.file( "unitTests/cpp/String.cpp" , package = "Rcpp" ) )
- sourceCpp(file.path(pathRcppTests, "cpp/String.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "String.cpp" )
test.replace_all <- function(){
checkEquals( String_replace_all("foobar", "o", "*"), "f**bar")
Modified: pkg/Rcpp/inst/unitTests/runit.Vector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.R 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.R 2013-07-17 10:02:17 UTC (rev 4394)
@@ -22,10 +22,7 @@
if (.runThisTest) {
-.setUp <- function() {
- #sourceCpp( system.file( "unitTests/cpp/Vector.cpp", package = "Rcpp" ) )
- sourceCpp(file.path(pathRcppTests, "cpp/Vector.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup("Vector.cpp")
test.RawVector <- function(){
funx <- raw_
Modified: pkg/Rcpp/inst/unitTests/runit.wstring.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.wstring.R 2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.wstring.R 2013-07-17 10:02:17 UTC (rev 4394)
@@ -23,10 +23,7 @@
if (.runThisTest) {
-.setUp <- function(){
- if (!exists("pathRcppTests")) pathRcppTests <- getwd()
- sourceCpp(file.path(pathRcppTests, "cpp/wstring.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "wstring.cpp" )
test.CharacterVector_wstring <- function(){
res <- CharacterVector_wstring()
More information about the Rcpp-commits
mailing list