[Rcpp-commits] r4369 - in pkg/RcppGSL: . inst/unitTests inst/unitTests/cpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jun 23 22:44:26 CEST 2013
Author: edd
Date: 2013-06-23 22:44:25 +0200 (Sun, 23 Jun 2013)
New Revision: 4369
Modified:
pkg/RcppGSL/ChangeLog
pkg/RcppGSL/inst/unitTests/cpp/gsl.cpp
pkg/RcppGSL/inst/unitTests/runit.gsl.R
Log:
brown paper bag corrections
Modified: pkg/RcppGSL/ChangeLog
===================================================================
--- pkg/RcppGSL/ChangeLog 2013-06-23 15:24:59 UTC (rev 4368)
+++ pkg/RcppGSL/ChangeLog 2013-06-23 20:44:25 UTC (rev 4369)
@@ -1,3 +1,8 @@
+2013-06-23 Dirk Eddelbuettel <edd at debian.org>
+
+ * inst/unitTests/runit.gsl.R: Corrections to new unitTest scheme
+ * inst/unitTests/cpp/gsl.cpp: Idem
+
2013-06-22 Dirk Eddelbuettel <edd at debian.org>
* inst/unitTests/runit.gsl.R: Rewritten to use sourceCpp()
Modified: pkg/RcppGSL/inst/unitTests/cpp/gsl.cpp
===================================================================
--- pkg/RcppGSL/inst/unitTests/cpp/gsl.cpp 2013-06-23 15:24:59 UTC (rev 4368)
+++ pkg/RcppGSL/inst/unitTests/cpp/gsl.cpp 2013-06-23 20:44:25 UTC (rev 4369)
@@ -19,9 +19,12 @@
// You should have received a copy of the GNU General Public License
// along with RcppGSL. If not, see <http://www.gnu.org/licenses/>.
-#include <Rcpp.h>
+#include <RcppGSL.h>
+
using namespace Rcpp;
+// [[Rcpp::depends(RcppGSL)]]
+
// [[Rcpp::export]]
List test_gsl_vector_wrapper() {
RcppGSL::vector<double> x_double( 10 );
@@ -155,7 +158,7 @@
gsl_matrix_ushort * x_ushort = gsl_matrix_ushort_alloc(5,2);
gsl_matrix_ushort_set_identity( x_ushort );
//gsl_matrix_ulong * x_ulong = gsl_matrix_ulong_alloc(5,2);
- gsl_matrix_ulong_set_identity( x_ulong );
+ //gsl_matrix_ulong_set_identity( x_ulong );
List res = List::create(_["gsl_matrix"] = *x_double ,
_["gsl_matrix_float"] = *x_float,
@@ -237,7 +240,7 @@
res += gsl_vector_get( vec, i );
}
vec.free();
- return wrap( res );
+ return res;
}
// [[Rcpp::export]]
@@ -250,7 +253,7 @@
res += mat( i, 0 );
}
mat.free();
- return wrap(res);
+ return res;
}
// [[Rcpp::export]]
@@ -280,11 +283,20 @@
RcppGSL::vector<double> vec = as< RcppGSL::vector<double> >(vec_);
double res= std::accumulate( vec.begin(), vec.end(), 0.0 );
vec.free();
- return wrap( res );
+ return res;
}
// [[Rcpp::export]]
-List test_gsl_matrix_indexing(NumericMatrix mat_) {
+NumericVector test_gsl_vector_iterator_transform(NumericVector vec_) {
+ RcppGSL::vector<double> vec = as< RcppGSL::vector<double> >(vec_);
+ NumericVector res(vec.size());
+ std::transform(vec.begin(), vec.end(), res.begin(), ::sqrt);
+ vec.free();
+ return res;
+}
+
+// [[Rcpp::export]]
+NumericMatrix test_gsl_matrix_indexing(NumericMatrix mat_) {
RcppGSL::matrix<double> mat= as< RcppGSL::matrix<double> >( mat_ );
for( size_t i=0; i< mat.nrow(); i++){
for( size_t j=0; j< mat.ncol(); j++){
@@ -339,11 +351,11 @@
int n = vec.size();
RcppGSL::vector_view<double> v_even = gsl_vector_subvector_with_stride(vec, 0, 2, n/2);
double res = std::accumulate( v_even.begin(), v_even.end(), 0.0 );
- return wrap( res );
+ return res;
}
// [[Rcpp::export]]
-List test_gsl_matrix_view_indexing() {
+double test_gsl_matrix_view_indexing() {
int nr = 10;
int nc = 10;
RcppGSL::matrix<double> mat( nr, nc );
@@ -361,6 +373,5 @@
}
}
mat.free();
- return wrap( res );
+ return res;
}
-
Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R 2013-06-23 15:24:59 UTC (rev 4368)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R 2013-06-23 20:44:25 UTC (rev 4369)
@@ -1,7 +1,7 @@
#!/usr/bin/r -t
# Emacs make this -*- mode: R; tab-width: 4 -*-
#
-# Copyright (C) 2010 Romain Francois and Dirk Eddelbuettel
+# Copyright (C) 2010 - 2013 Romain Francois and Dirk Eddelbuettel
#
# This file is part of RcppGSL.
#
@@ -18,8 +18,9 @@
# You should have received a copy of the GNU General Public License
# along with RcppGSL. If not, see <http://www.gnu.org/licenses/>.
-.setUp <- function(){
- if (!exists("pathRcppTests")) pathRcppTests <- getwd()
+.setUp <- function() {
+ if (!exists("pathRcppTests"))
+ pathRcppTests <- system.file("unitTests", package="RcppGSL")
sourceCpp(file.path(pathRcppTests, "cpp/gsl.cpp"))
}
@@ -117,7 +118,7 @@
res <- fx()
checkEquals( res$full[3:4, 3:4], res$view, msg = "wrap(gsl.matrix.view)" )
- fx <- .rcppgsl.tests$test_gsl_matrix_view_wrapper
+ fx <- test_gsl_matrix_view_wrapper
res <- fx()
checkEquals( res$full[3:4, 3:4], res$view, msg = "wrap(gsl.matrix.view.wrapper)" )
}
@@ -155,6 +156,13 @@
checkEquals( res, sum(x) )
}
+test.gsl.RcppGSL.vector.iterator.transform <- function() {
+ x <- seq(0.5, 10.5)
+ fx <- test_gsl_vector_iterator_transform
+ res <- fx(x)
+ checkEquals(res, sqrt(x))
+}
+
test.gsl.RcppGSL.matrix.indexing <- function(){
m <- matrix( 1:16+.5, nr = 4 )
fx <- test_gsl_matrix_indexing
More information about the Rcpp-commits
mailing list