Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Modernizing fastlm and functionCallback#535

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to ourterms of service andprivacy statement. We’ll occasionally send you account related emails.

Already on GitHub?Sign in to your account

Merged
eddelbuettel merged 1 commit intoRcppCore:masterfromcoatless:modernizing-fastlm
Aug 8, 2016
Merged
Show file tree
Hide file tree
Changes fromall commits
Commits
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 12 additions & 0 deletionsChangeLog
View file
Open in desktop
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,15 @@
2016-08-05 James J Balamuta <balamut2@illinois.edu>

* inst/examples/FastLM/fastLMviaArmadillo.r: format fix
* inst/examples/FastLM/lmGSL.R: Updated example to use
Rcpp attributes instead of cxxfunction
* inst/examples/FastLM/lmArmadillo.R: Idem
* inst/examples/functionCallback/newApiExample.r: Idem
* inst/examples/RcppInline/RcppInlineExample.r: Idem
* inst/examples/RcppInline/RcppInlineWithLibsExamples.r: Idem
* inst/examples/RcppInline/UncaughtExceptions.r: Idem
* inst/examples/RcppInline/external_pointer.r: Idem

2016-08-04 James J Balamuta <balamut2@illinois.edu>

* src/attributes.cpp: Correct variable re-declaration
Expand Down
3 changes: 2 additions & 1 deletioninst/NEWS.Rd
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -31,7 +31,8 @@
\itemize{
\item Examples that used cxxfunction() from the inline package have been
rewritten to use either sourceCpp() or cppFunction()
(James Balamuta in \ghpr{532} addressing issue \ghit{56}).
(James Balamuta in \ghpr{535}, \ghpr{534}, and \ghpr{532}
addressing issue \ghit{56}).
}
}
}
Expand Down
4 changes: 2 additions & 2 deletionsinst/examples/FastLM/fastLMviaArmadillo.r
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -27,8 +27,8 @@ checkLmArmadillo <- function(y, X) {
fun <- lmArmadillo()
res <- fun(y, X)
fit <- lm(y ~ X - 1)
rc <- all.equal( res[[1]], as.numeric(coef(fit))) &
all.equal( res[[2]], as.numeric(coef(summary(fit))[,2]))
rc <- all.equal(as.numeric(res[[1]]), as.numeric(coef(fit))) &
all.equal(as.numeric(res[[2]]), as.numeric(coef(summary(fit))[,2]))
invisible(rc)
}

Expand Down
36 changes: 34 additions & 2 deletionsinst/examples/FastLM/lmArmadillo.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -19,9 +19,14 @@
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.

suppressMessages(require(Rcpp))

## NOTE: This is the old way to compile Rcpp code inline.
## The code here has left as a historical artifact and tribute to the old way.
## Please use the code under the "new" inline compilation section.

suppressMessages(require(inline))

lmArmadillo <- function() {
lmArmadillo_old <- function() {
src <- '

Rcpp::NumericVector yr(Ysexp);
Expand DownExpand Up@@ -49,9 +54,36 @@ lmArmadillo <- function() {
'

## turn into a function that R can call
fun <- cxxfunction(signature(Ysexp="numeric", Xsexp="numeric"),
fun_old <- cxxfunction(signature(Ysexp="numeric", Xsexp="numeric"),
src,
includes="#include <armadillo>",
plugin="RcppArmadillo")
}


## NOTE: Within this section, the new way to compile Rcpp code inline has been
## written. Please use the code next as a template for your own project.

lmArmadillo <- function() {

sourceCpp(code='
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]

// [[Rcpp::export]]
Rcpp::List fun(const arma::vec & y, const arma::mat & X){

int n = X.n_rows, k = X.n_cols;

arma::vec coef = solve(X, y);// fit model y ~ X

arma::vec resid = y - X*coef; // to compute std. error of the coefficients
double sig2 = arma::as_scalar(trans(resid)*resid)/(n-k);// requires Armadillo 0.8.2 or later
arma::mat covmat = sig2 * arma::inv(arma::trans(X)*X);

return Rcpp::List::create( Rcpp::Named( "coefficients") = coef,
Rcpp::Named( "stderr") = sqrt(arma::diagvec(covmat)));
}')

fun
}
56 changes: 54 additions & 2 deletionsinst/examples/FastLM/lmGSL.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -19,9 +19,14 @@
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.

suppressMessages(require(Rcpp))

## NOTE: This is the old way to compile Rcpp code inline.
## The code here has left as a historical artifact and tribute to the old way.
## Please use the code under the "new" inline compilation section.

suppressMessages(require(inline))

lmGSL <- function() {
lmGSL_old <- function() {

src <- '

Expand DownExpand Up@@ -62,8 +67,55 @@ lmGSL <- function() {

## turn into a function that R can call
## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
fun <- cxxfunction(signature(Ysexp="numeric", Xsexp="numeric"),
fun_old <- cxxfunction(signature(Ysexp="numeric", Xsexp="numeric"),
src,
includes="#include <gsl/gsl_multifit.h>",
plugin="RcppGSL")
}

## NOTE: Within this section, the new way to compile Rcpp code inline has been
## written. Please use the code next as a template for your own project.

lmGSL <- function() {

sourceCpp(code='
#include <RcppGSL.h>
#include <gsl/gsl_multifit.h>
// [[Rcpp::depends(RcppGSL)]]

// [[Rcpp::export]]
Rcpp::List fun(Rcpp::NumericVector Yr, Rcpp::NumericMatrix Xr){

int i,j,n = Xr.nrow(), k = Xr.ncol();
double chisq;

gsl_matrix *X = gsl_matrix_alloc (n, k);
gsl_vector *y = gsl_vector_alloc (n);
gsl_vector *c = gsl_vector_alloc (k);
gsl_matrix *cov = gsl_matrix_alloc (k, k);
for (i = 0; i < n; i++) {
for (j = 0; j < k; j++)
gsl_matrix_set (X, i, j, Xr(i,j));
gsl_vector_set (y, i, Yr(i));
}

gsl_multifit_linear_workspace *work = gsl_multifit_linear_alloc (n, k);
gsl_multifit_linear (X, y, c, cov, &chisq, work);
gsl_multifit_linear_free (work);

Rcpp::NumericVector coefr(k), stderrestr(k);
for (i = 0; i < k; i++) {
coefr(i) = gsl_vector_get(c,i);
stderrestr(i) = sqrt(gsl_matrix_get(cov,i,i));
}
gsl_matrix_free (X);
gsl_vector_free (y);
gsl_vector_free (c);
gsl_matrix_free (cov);


return Rcpp::List::create( Rcpp::Named( "coef", coefr),
Rcpp::Named( "stderr", stderrestr));
}')
fun
}
21 changes: 20 additions & 1 deletioninst/examples/functionCallback/newApiExample.r
View file
Open in desktop
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
#!/usr/bin/env r

suppressMessages(library(Rcpp))
suppressMessages(library(inline))

# R function that will be called from C++
vecfunc <- function(x) {
Expand All@@ -12,6 +11,12 @@ vecfunc <- function(x) {
return(y)
}

## NOTE: This is the old way to compile Rcpp code inline.
## The code here has left as a historical artifact and tribute to the old way.
## Please use the code under the "new" inline compilation section.

suppressMessages(library(inline))

# C++ source code to operate on function and vector
cpp <- '
int n = as<int>(N);
Expand All@@ -27,6 +32,20 @@ cpp <- '
funx <- cxxfunction(signature(N = "integer" , xvec = "numeric", fun = "function" ),
body=cpp, include = "using namespace Rcpp; ", plugin = "Rcpp")


## NOTE: Within this section, the new way to compile Rcpp code inline has been
## written. Please use the code next as a template for your own project.

# C++ source code to operate on function and vector
cppFunction('
NumericVector funx(int n, NumericVector numvec, Function f){
for( int i = 0; i < n; i++ ){
numvec = f( numvec ) ;
}
return numvec ;
}')


# create the vector
xvec <- sqrt(c(1:12, 11:1))

Expand Down
[8]ページ先頭
©2009-2025 Movatter.jp