[Rcpp-commits] r1800 - pkg/Rcpp/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 7 13:44:25 CEST 2010
Author: edd
Date: 2010-07-07 13:44:25 +0200 (Wed, 07 Jul 2010)
New Revision: 1800
Modified:
pkg/Rcpp/inst/unitTests/runit.DataFrame.R
Log:
converted to 'one cxxfunction call of lists of sigs and bodies' scheme
Modified: pkg/Rcpp/inst/unitTests/runit.DataFrame.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.DataFrame.R 2010-07-07 09:28:09 UTC (rev 1799)
+++ pkg/Rcpp/inst/unitTests/runit.DataFrame.R 2010-07-07 11:44:25 UTC (rev 1800)
@@ -1,4 +1,5 @@
#!/usr/bin/r -t
+# -*- mode: R; tab-width: 4 -*-
#
# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
#
@@ -20,110 +21,138 @@
.setUp <- function(){
suppressMessages( require( datasets ) )
data( iris )
+
+ tests <- ".Rcpp.DataFrame"
+ if( ! exists(tests, globalenv() )) {
+ ## definition of all the functions at once
+ f <- list("FromSEXP"=list(
+ signature(x="ANY"),
+ 'DataFrame df(x) ;
+ return df;')
+
+ ,"index_byName"=list(
+ signature(x='ANY', y='character'),
+ 'DataFrame df(x);
+ std::string s = as<std::string>(y);
+ return df[s];')
+
+ ,"index_byPosition"=list(
+ signature(x='ANY', y='integer'),
+ 'DataFrame df(x);
+ int i = as<int>(y);
+ return df[i]; ')
+
+ ,"string_element"=list(
+ signature(x='ANY'),
+ 'DataFrame df(x);
+ CharacterVector b = df[1];
+ std::string s;
+ s = b[1];
+ return wrap(s); ')
+
+ ,"createOne"=list(
+ signature(),
+ 'IntegerVector v = IntegerVector::create(1,2,3);
+ return DataFrame::create(Named("a")=v); ')
+
+ ,"createTwo"=list(
+ signature(),
+ 'IntegerVector v = IntegerVector::create(1,2,3);
+ std::vector<std::string> s(3);
+ s[0] = "a";
+ s[1] = "b";
+ s[2] = "c";
+ return DataFrame::create(Named("a")=v, Named("b")=s); ')
+
+ ,"SlotProxy"=list(
+ signature(x="ANY", y="character"),
+ 'S4 o(x) ;
+ return DataFrame( o.slot( as<std::string>(y) )) ; ')
+
+ ,"AttributeProxy"=list(
+ signature(x="ANY", y="character"),
+ 'List o(x) ;
+ return DataFrame( o.attr( as<std::string>(y) )) ; ')
+
+ ,"createTwoStringsAsFactors"=list(
+ signature(),
+ 'IntegerVector v = IntegerVector::create(1,2,3);
+ std::vector<std::string> s(3);
+ s[0] = "a";
+ s[1] = "b";
+ s[2] = "c";
+ return DataFrame::create(
+ _["a"] = v,
+ _["b"] = s,
+ _["stringsAsFactors"] = false ); ')
+
+ )
+
+ signatures <- lapply(f, "[[", 1L)
+ bodies <- lapply(f, "[[", 2L)
+ fun <- cxxfunction(signatures, bodies,
+ plugin = "Rcpp", includes = "using namespace std;")
+ getDynLib( fun ) # just forcing loading the dll now
+ assign( tests, fun, globalenv() )
+ }
}
test.DataFrame.FromSEXP <- function() {
DF <- data.frame(a=1:3, b=c("a","b","c"))
- fun <- cppfunction( signature(x='ANY'), '
- DataFrame df(x) ;
- return df;
- ' )
+ fun <- .Rcpp.DataFrame$FromSEXP
checkEquals( fun(DF), DF, msg = "DataFrame pass-through")
}
test.DataFrame.index.byName <- function() {
DF <- data.frame(a=1:3, b=c("a","b","c"))
- fun <- cppfunction( signature(x='ANY', y='character'), '
- DataFrame df(x);
- std::string s = as<std::string>(y);
- return df[s];
- ' )
+ fun <- .Rcpp.DataFrame$index_byName
checkEquals( fun(DF, "a"), DF$a, msg = "DataFrame column by name 'a'")
checkEquals( fun(DF, "b"), DF$b, msg = "DataFrame column by name 'b'")
}
test.DataFrame.index.byPosition <- function() {
DF <- data.frame(a=1:3, b=c("a","b","c"))
- fun <- cppfunction( signature(x='ANY', y='integer'), '
- DataFrame df(x);
- int i = as<int>(y);
- return df[i];
- ' )
+ fun <- .Rcpp.DataFrame$index_byPosition
checkEquals( fun(DF, 0), DF$a, msg = "DataFrame column by position 0")
checkEquals( fun(DF, 1), DF$b, msg = "DataFrame column by position 1")
}
test.DataFrame.string.element <- function() {
DF <- data.frame(a=1:3, b=c("a","b","c"), stringsAsFactors=FALSE)
- fun <- cppfunction( signature(x='ANY'), '
- DataFrame df(x);
- CharacterVector b = df[1];
- std::string s;
- s = b[1];
- return wrap(s);
- ' )
+ fun <- .Rcpp.DataFrame$string_element
checkEquals( fun(DF), DF[2,"b"], msg = "DataFrame string element")
}
test.DataFrame.CreateOne <- function() {
DF <- data.frame(a=1:3)
- fun <- cppfunction( signature(), '
- IntegerVector v = IntegerVector::create(1,2,3);
- return DataFrame::create(Named("a")=v);
- ' )
+ fun <- .Rcpp.DataFrame$createOne
checkEquals( fun(), DF, msg = "DataFrame create1")
}
test.DataFrame.CreateTwo <- function() {
DF <- data.frame(a=1:3, b=c("a","b","c"))
- fun <- cppfunction( signature(), '
- IntegerVector v = IntegerVector::create(1,2,3);
- std::vector<std::string> s(3);
- s[0] = "a";
- s[1] = "b";
- s[2] = "c";
- return DataFrame::create(Named("a")=v, Named("b")=s);
- ' )
+ fun <- .Rcpp.DataFrame$createTwo
checkEquals( fun(), DF, msg = "DataFrame create2")
}
test.DataFrame.SlotProxy <- function(){
-
setClass("track", representation(x="data.frame", y = "function"))
tr1 <- new( "track", x = iris, y = rnorm )
- fun <- cppfunction( signature(x="ANY", y="character"), '
- S4 o(x) ;
- return DataFrame( o.slot( as<std::string>(y) )) ;
- ' )
+ fun <- .Rcpp.DataFrame$SlotProxy
checkTrue( identical( fun(tr1, "x"), iris ), msg = "DataFrame( SlotProxy )" )
checkException( fun(tr1, "y"), msg = "DataFrame( SlotProxy ) -> exception" )
}
test.DataFrame.AttributeProxy <- function(){
-
tr1 <- structure( NULL, x = iris, y = rnorm )
- fun <- cppfunction( signature(x="ANY", y="character"), '
- List o(x) ;
- return DataFrame( o.attr( as<std::string>(y) )) ;
- ' )
+ fun <- .Rcpp.DataFrame$AttributeProxy
checkTrue( identical( fun(tr1, "x"), iris) , msg = "DataFrame( AttributeProxy )" )
checkException( fun(tr1, "y"), msg = "DataFrame( AttributeProxy ) -> exception" )
-
}
test.DataFrame.CreateTwo.stringsAsFactors <- function() {
DF <- data.frame(a=1:3, b=c("a","b","c"), stringsAsFactors = FALSE )
- fun <- cppfunction( signature(), '
- IntegerVector v = IntegerVector::create(1,2,3);
- std::vector<std::string> s(3);
- s[0] = "a";
- s[1] = "b";
- s[2] = "c";
- return DataFrame::create(
- _["a"] = v,
- _["b"] = s,
- _["stringsAsFactors"] = false );
- ' )
+ fun <- .Rcpp.DataFrame$createTwoStringsAsFactors
checkEquals( fun(), DF, msg = "DataFrame create2 stringsAsFactors = false")
}
More information about the Rcpp-commits
mailing list