Skip to content

Commit 17eb66c

Browse files
eddelbuetteleddelbuettel
committed
updated fastLm() etc to use Rcpp Attributes
1 parent 35dbaf9 commit 17eb66c

File tree

9 files changed

+136
-80
lines changed

9 files changed

+136
-80
lines changed

‎ChangeLog‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,11 @@
1+
2015-08-21 Dirk Eddelbuettel <edd@debian.org>
2+
3+
* src/RcppEigen.cpp: Updated code to use Rcpp Attributes
4+
* src/fastLm.cpp: Ditto
5+
* src/fastLm.h: Ditto
6+
* R/fastLm.R: Ditto
7+
* inst/unitTests/runit.fastLm.R: Ditto
8+
19
2015-08-04 Dirk Eddelbuettel <edd@debian.org>
210

311
* R/RcppEigen.package.skeleton.R: Correct kitten() use based on patch

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Package: RcppEigen
22
Type: Package
33
Title: 'Rcpp' Integration for the 'Eigen' Templated Linear Algebra Library
4-
Version: 0.3.2.5.0
5-
Date: 2015-07-13
4+
Version: 0.3.2.5.1
5+
Date: 2015-08-21
66
Author: Douglas Bates, Romain Francois and Dirk Eddelbuettel;
77
the authors of Eigen for the included version of Eigen
88
Maintainer: Dirk Eddelbuettel <edd@debian.org>

‎R/RcppExports.R‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
# This file was generated by Rcpp::compileAttributes
2+
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
3+
4+
fastLm <- function(X, y, type) {
5+
.Call('RcppEigen_fastLm', PACKAGE = 'RcppEigen', X, y, type)
6+
}
7+
8+
eigen_version <- function(single) {
9+
.Call('RcppEigen_eigen_version', PACKAGE = 'RcppEigen', single)
10+
}
11+
12+
Eigen_SSE <- function() {
13+
.Call('RcppEigen_Eigen_SSE', PACKAGE = 'RcppEigen')
14+
}
15+

‎R/fastLm.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
## fastLm.R: Rcpp/Eigen implementation of lm()
22
##
3-
## Copyright (C) 2011 - 2012 Douglas Bates, Dirk Eddelbuettel and Romain Francois
3+
## Copyright (C) 2011 - 2015 Douglas Bates, Dirk Eddelbuettel and Romain Francois
44
##
55
## This file is part of RcppEigen.
66
##
@@ -21,7 +21,7 @@ fastLmPure <- function(X, y, method = 0L) {
2121

2222
stopifnot(is.matrix(X), is.numeric(y), NROW(y)==nrow(X))
2323

24-
.Call("fastLm", X, y, as.integer(method[1]), PACKAGE="RcppEigen")
24+
.Call("RcppEigen_fastLm", X, y, method, colnames(X), PACKAGE="RcppEigen")
2525
}
2626

2727
fastLm <- function(X, ...) UseMethod("fastLm")
@@ -31,7 +31,7 @@ fastLm.default <- function(X, y, method = 0L, ...) {
3131
X <- as.matrix(X)
3232
y <- as.numeric(y)
3333

34-
res <- fastLmPure(X, y, as.integer(method[1]))
34+
res <- fastLmPure(X, y, method)
3535
res$call <- match.call()
3636
res$intercept <- any(apply(X, 2, function(x) all(x == x[1])))
3737

‎inst/unitTests/runit.fastLm.R‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#!/usr/bin/r -t
22
#
3-
# Copyright (C) 2011 Douglas Bates, Dirk Eddelbuettel and Romain Francois
3+
# Copyright (C) 2011 - 2015 Douglas Bates, Dirk Eddelbuettel and Romain Francois
44
#
55
# This file is part of RcppEigen
66
#
@@ -24,27 +24,27 @@
2424

2525
test.fastLm <- function() {
2626
data(trees, package="datasets")
27-
flm0 <- .Call("fastLm",
27+
flm0 <- .Call("RcppEigen_fastLm",
2828
cbind(1, log(trees$Girth)),
2929
log(trees$Volume), 0L,
3030
PACKAGE="RcppEigen")
31-
flm1 <- .Call("fastLm",
31+
flm1 <- .Call("RcppEigen_fastLm",
3232
cbind(1, log(trees$Girth)),
3333
log(trees$Volume), 1L,
3434
PACKAGE="RcppEigen")
35-
flm2 <- .Call("fastLm",
35+
flm2 <- .Call("RcppEigen_fastLm",
3636
cbind(1, log(trees$Girth)),
3737
log(trees$Volume), 2L,
3838
PACKAGE="RcppEigen")
39-
flm3 <- .Call("fastLm",
39+
flm3 <- .Call("RcppEigen_fastLm",
4040
cbind(1, log(trees$Girth)),
4141
log(trees$Volume), 3L,
4242
PACKAGE="RcppEigen")
43-
flm4 <- .Call("fastLm",
43+
flm4 <- .Call("RcppEigen_fastLm",
4444
cbind(1, log(trees$Girth)),
4545
log(trees$Volume), 4L,
4646
PACKAGE="RcppEigen")
47-
flm5 <- .Call("fastLm",
47+
flm5 <- .Call("RcppEigen_fastLm",
4848
cbind(1, log(trees$Girth)),
4949
log(trees$Volume), 5L,
5050
PACKAGE="RcppEigen")

‎src/RcppEigen.cpp‎

Lines changed: 17 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
//
33
// RcppEigen.cpp: Rcpp/Eigen glue
44
//
5-
// Copyright (C) 2011 Douglas Bates, Dirk Eddelbuettel and Romain Francois
5+
// Copyright (C) 2011 - 2015 Douglas Bates, Dirk Eddelbuettel and Romain Francois
66
//
77
// This file is part of RcppEigen.
88
//
@@ -21,32 +21,23 @@
2121

2222
#include <RcppEigen.h>
2323

24-
extern "C" {
25-
SEXP eigen_version(SEXP single_){
26-
using Rcpp::_;
27-
using Rcpp::IntegerVector;
24+
// [[Rcpp::export]]
25+
Rcpp::IntegerVector eigen_version(bool single) {
26+
using Rcpp::_;
27+
using Rcpp::IntegerVector;
2828

29-
BEGIN_RCPP;
30-
bool single = Rcpp::as<bool>(single_) ;
31-
if( single ){
32-
return Rcpp::wrap( 10000 * EIGEN_WORLD_VERSION +
33-
100 * EIGEN_MAJOR_VERSION +
34-
EIGEN_MINOR_VERSION ) ;
35-
}
36-
37-
return IntegerVector::create(_["major"] = EIGEN_WORLD_VERSION,
38-
_["minor"] = EIGEN_MAJOR_VERSION,
39-
_["patch"] = EIGEN_MINOR_VERSION);
40-
END_RCPP;
41-
}
42-
43-
SEXP Eigen_SSE() {
44-
BEGIN_RCPP;
45-
return Rcpp::wrap(Eigen::SimdInstructionSetsInUse());
46-
END_RCPP;
29+
if (single) {
30+
return Rcpp::wrap( 10000 * EIGEN_WORLD_VERSION +
31+
100 * EIGEN_MAJOR_VERSION +
32+
EIGEN_MINOR_VERSION ) ;
4733
}
34+
35+
return IntegerVector::create(_["major"] = EIGEN_WORLD_VERSION,
36+
_["minor"] = EIGEN_MAJOR_VERSION,
37+
_["patch"] = EIGEN_MINOR_VERSION);
4838
}
4939

50-
51-
52-
40+
// [[Rcpp::export]]
41+
bool Eigen_SSE() {
42+
return Rcpp::wrap(Eigen::SimdInstructionSetsInUse());
43+
}

‎src/RcppExports.cpp‎

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
// This file was generated by Rcpp::compileAttributes
2+
// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
3+
4+
#include "../inst/include/RcppEigen.h"
5+
#include <Rcpp.h>
6+
7+
using namespace Rcpp;
8+
9+
// fastLm
10+
Rcpp::List fastLm(Rcpp::NumericMatrix X, Rcpp::NumericVector y, int type);
11+
RcppExport SEXP RcppEigen_fastLm(SEXP XSEXP, SEXP ySEXP, SEXP typeSEXP) {
12+
BEGIN_RCPP
13+
Rcpp::RObject __result;
14+
Rcpp::RNGScope __rngScope;
15+
Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type X(XSEXP);
16+
Rcpp::traits::input_parameter< Rcpp::NumericVector >::type y(ySEXP);
17+
Rcpp::traits::input_parameter< int >::type type(typeSEXP);
18+
__result = Rcpp::wrap(fastLm(X, y, type));
19+
return __result;
20+
END_RCPP
21+
}
22+
// eigen_version
23+
Rcpp::IntegerVector eigen_version(bool single);
24+
RcppExport SEXP RcppEigen_eigen_version(SEXP singleSEXP) {
25+
BEGIN_RCPP
26+
Rcpp::RObject __result;
27+
Rcpp::RNGScope __rngScope;
28+
Rcpp::traits::input_parameter< bool >::type single(singleSEXP);
29+
__result = Rcpp::wrap(eigen_version(single));
30+
return __result;
31+
END_RCPP
32+
}
33+
// Eigen_SSE
34+
bool Eigen_SSE();
35+
RcppExport SEXP RcppEigen_Eigen_SSE() {
36+
BEGIN_RCPP
37+
Rcpp::RObject __result;
38+
Rcpp::RNGScope __rngScope;
39+
__result = Rcpp::wrap(Eigen_SSE());
40+
return __result;
41+
END_RCPP
42+
}

‎src/fastLm.cpp‎

Lines changed: 40 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
//
33
// fastLm.cpp: Rcpp/Eigen example of a simple lm() alternative
44
//
5-
// Copyright (C) 2011 Douglas Bates, Dirk Eddelbuettel and Romain Francois
5+
// Copyright (C) 2011 - 2015 Douglas Bates, Dirk Eddelbuettel and Romain Francois
66
//
77
// This file is part of RcppEigen.
88
//
@@ -202,45 +202,45 @@ namespace lmsol {
202202
return ColPivQR(X, y); // -Wall
203203
}
204204

205-
extern "C" SEXP fastLm(SEXP Xs, SEXP ys, SEXP type) {
206-
try {
207-
const Map<MatrixXd> X(as<Map<MatrixXd> >(Xs));
208-
const Map<VectorXd> y(as<Map<VectorXd> >(ys));
209-
Index n = X.rows();
210-
if ((Index)y.size() != n) throw invalid_argument("size mismatch");
211-
212-
// Select and apply the least squares method
213-
lm ans(do_lm(X, y, ::Rf_asInteger(type)));
214-
215-
// Copy coefficients and install names, if any
216-
NumericVector coef(wrap(ans.coef()));
217-
List dimnames(NumericMatrix(Xs).attr("dimnames"));
218-
if (dimnames.size() > 1) {
219-
RObject colnames = dimnames[1];
220-
if (!(colnames).isNULL())
221-
coef.attr("names") = clone(CharacterVector(colnames));
222-
}
205+
List fastLm(Rcpp::NumericMatrix Xs, Rcpp::NumericVector ys, int type) {
206+
const Map<MatrixXd> X(as<Map<MatrixXd> >(Xs));
207+
const Map<VectorXd> y(as<Map<VectorXd> >(ys));
208+
Index n = X.rows();
209+
if ((Index)y.size() != n) throw invalid_argument("size mismatch");
210+
211+
// Select and apply the least squares method
212+
lm ans(do_lm(X, y, type));
213+
214+
// Copy coefficients and install names, if any
215+
NumericVector coef(wrap(ans.coef()));
216+
217+
List dimnames(NumericMatrix(Xs).attr("dimnames"));
218+
if (dimnames.size() > 1) {
219+
RObject colnames = dimnames[1];
220+
if (!(colnames).isNULL())
221+
coef.attr("names") = clone(CharacterVector(colnames));
222+
}
223223

224-
VectorXd resid = y - ans.fitted();
225-
int rank = ans.rank();
226-
int df = (rank == ::NA_INTEGER) ? n - X.cols() : n - rank;
227-
double s = resid.norm() / std::sqrt(double(df));
228-
// Create the standard errors
229-
VectorXd se = s * ans.se();
230-
231-
return List::create(_["coefficients"] = coef,
232-
_["se"] = se,
233-
_["rank"] = rank,
234-
_["df.residual"] = df,
235-
_["residuals"] = resid,
236-
_["s"] = s,
237-
_["fitted.values"] = ans.fitted());
238-
239-
} catch( std::exception &ex ) {
240-
forward_exception_to_r( ex );
241-
} catch(...) {
242-
::Rf_error( "c++ exception (unknown reason)" );
243-
}
244-
return R_NilValue; // -Wall
224+
VectorXd resid = y - ans.fitted();
225+
int rank = ans.rank();
226+
int df = (rank == ::NA_INTEGER) ? n - X.cols() : n - rank;
227+
double s = resid.norm() / std::sqrt(double(df));
228+
// Create the standard errors
229+
VectorXd se = s * ans.se();
230+
231+
return List::create(_["coefficients"] = coef,
232+
_["se"] = se,
233+
_["rank"] = rank,
234+
_["df.residual"] = df,
235+
_["residuals"] = resid,
236+
_["s"] = s,
237+
_["fitted.values"] = ans.fitted());
245238
}
246239
}
240+
241+
// This defines the R-callable function 'fastLm'
242+
// [[Rcpp::export]]
243+
Rcpp::List fastLm(Rcpp::NumericMatrix X, Rcpp::NumericVector y, int type) {
244+
return lmsol::fastLm(X, y, type);
245+
}
246+

‎src/fastLm.h‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
//
33
// fastLm.h: Rcpp/Eigen example of a simple lm() alternative
44
//
5-
// Copyright (C) 2011 Douglas Bates, Dirk Eddelbuettel and Romain Francois
5+
// Copyright (C) 2011 - 2015 Douglas Bates, Dirk Eddelbuettel and Romain Francois
66
//
77
// This file is part of RcppEigen.
88
//
@@ -112,7 +112,7 @@ namespace lmsol {
112112
};
113113
}
114114

115-
extern "C" SEXP fastLm(SEXP Xs, SEXP ys, SEXP types);
115+
// extern "C" SEXP fastLm(SEXP Xs, SEXP ys, SEXP types);
116116

117117
#endif
118118

0 commit comments

Comments
 (0)