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

Commitf2bcaf4

Browse files
authored
Merge pull request#535 from coatless/modernizing-fastlm
Modernizing fastlm and functionCallback
2 parents9fbdf78 +057cac9 commitf2bcaf4

File tree

6 files changed

+124
-8
lines changed

6 files changed

+124
-8
lines changed

‎ChangeLog‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,15 @@
1+
2016-08-05 James J Balamuta <balamut2@illinois.edu>
2+
3+
* inst/examples/FastLM/fastLMviaArmadillo.r: format fix
4+
* inst/examples/FastLM/lmGSL.R: Updated example to use
5+
Rcpp attributes instead of cxxfunction
6+
* inst/examples/FastLM/lmArmadillo.R: Idem
7+
* inst/examples/functionCallback/newApiExample.r: Idem
8+
* inst/examples/RcppInline/RcppInlineExample.r: Idem
9+
* inst/examples/RcppInline/RcppInlineWithLibsExamples.r: Idem
10+
* inst/examples/RcppInline/UncaughtExceptions.r: Idem
11+
* inst/examples/RcppInline/external_pointer.r: Idem
12+
113
2016-08-04 James J Balamuta <balamut2@illinois.edu>
214

315
* src/attributes.cpp: Correct variable re-declaration

‎inst/NEWS.Rd‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,8 @@
3131
\itemize{
3232
\itemExamplesthatused cxxfunction()fromtheinlinepackagehavebeen
3333
rewrittentouseeither sourceCpp()or cppFunction()
34-
(JamesBalamutain \ghpr{532}addressingissue \ghit{56}).
34+
(JamesBalamutain \ghpr{535}, \ghpr{534},and \ghpr{532}
35+
addressingissue \ghit{56}).
3536
}
3637
}
3738
}

‎inst/examples/FastLM/fastLMviaArmadillo.r‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,8 @@ checkLmArmadillo <- function(y, X) {
2727
fun<- lmArmadillo()
2828
res<- fun(y,X)
2929
fit<- lm(y~X-1)
30-
rc<- all.equal(res[[1]], as.numeric(coef(fit)))&
31-
all.equal(res[[2]], as.numeric(coef(summary(fit))[,2]))
30+
rc<- all.equal(as.numeric(res[[1]]), as.numeric(coef(fit)))&
31+
all.equal(as.numeric(res[[2]]), as.numeric(coef(summary(fit))[,2]))
3232
invisible(rc)
3333
}
3434

‎inst/examples/FastLM/lmArmadillo.R‎

Lines changed: 34 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,14 @@
1919
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
2020

2121
suppressMessages(require(Rcpp))
22+
23+
## NOTE: This is the old way to compile Rcpp code inline.
24+
## The code here has left as a historical artifact and tribute to the old way.
25+
## Please use the code under the "new" inline compilation section.
26+
2227
suppressMessages(require(inline))
2328

24-
lmArmadillo<-function() {
29+
lmArmadillo_old<-function() {
2530
src<-'
2631
2732
Rcpp::NumericVector yr(Ysexp);
@@ -49,9 +54,36 @@ lmArmadillo <- function() {
4954
'
5055

5156
## turn into a function that R can call
52-
fun<- cxxfunction(signature(Ysexp="numeric",Xsexp="numeric"),
57+
fun_old<- cxxfunction(signature(Ysexp="numeric",Xsexp="numeric"),
5358
src,
5459
includes="#include <armadillo>",
5560
plugin="RcppArmadillo")
5661
}
5762

63+
64+
## NOTE: Within this section, the new way to compile Rcpp code inline has been
65+
## written. Please use the code next as a template for your own project.
66+
67+
lmArmadillo<-function() {
68+
69+
sourceCpp(code='
70+
#include <RcppArmadillo.h>
71+
// [[Rcpp::depends(RcppArmadillo)]]
72+
73+
// [[Rcpp::export]]
74+
Rcpp::List fun(const arma::vec & y, const arma::mat & X){
75+
76+
int n = X.n_rows, k = X.n_cols;
77+
78+
arma::vec coef = solve(X, y);// fit model y ~ X
79+
80+
arma::vec resid = y - X*coef; // to compute std. error of the coefficients
81+
double sig2 = arma::as_scalar(trans(resid)*resid)/(n-k);// requires Armadillo 0.8.2 or later
82+
arma::mat covmat = sig2 * arma::inv(arma::trans(X)*X);
83+
84+
return Rcpp::List::create( Rcpp::Named( "coefficients") = coef,
85+
Rcpp::Named( "stderr") = sqrt(arma::diagvec(covmat)));
86+
}')
87+
88+
fun
89+
}

‎inst/examples/FastLM/lmGSL.R‎

Lines changed: 54 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,14 @@
1919
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
2020

2121
suppressMessages(require(Rcpp))
22+
23+
## NOTE: This is the old way to compile Rcpp code inline.
24+
## The code here has left as a historical artifact and tribute to the old way.
25+
## Please use the code under the "new" inline compilation section.
26+
2227
suppressMessages(require(inline))
2328

24-
lmGSL<-function() {
29+
lmGSL_old<-function() {
2530

2631
src<-'
2732
@@ -62,8 +67,55 @@ lmGSL <- function() {
6267

6368
## turn into a function that R can call
6469
## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
65-
fun<- cxxfunction(signature(Ysexp="numeric",Xsexp="numeric"),
70+
fun_old<- cxxfunction(signature(Ysexp="numeric",Xsexp="numeric"),
6671
src,
6772
includes="#include <gsl/gsl_multifit.h>",
6873
plugin="RcppGSL")
6974
}
75+
76+
## NOTE: Within this section, the new way to compile Rcpp code inline has been
77+
## written. Please use the code next as a template for your own project.
78+
79+
lmGSL<-function() {
80+
81+
sourceCpp(code='
82+
#include <RcppGSL.h>
83+
#include <gsl/gsl_multifit.h>
84+
// [[Rcpp::depends(RcppGSL)]]
85+
86+
// [[Rcpp::export]]
87+
Rcpp::List fun(Rcpp::NumericVector Yr, Rcpp::NumericMatrix Xr){
88+
89+
int i,j,n = Xr.nrow(), k = Xr.ncol();
90+
double chisq;
91+
92+
gsl_matrix *X = gsl_matrix_alloc (n, k);
93+
gsl_vector *y = gsl_vector_alloc (n);
94+
gsl_vector *c = gsl_vector_alloc (k);
95+
gsl_matrix *cov = gsl_matrix_alloc (k, k);
96+
for (i = 0; i < n; i++) {
97+
for (j = 0; j < k; j++)
98+
gsl_matrix_set (X, i, j, Xr(i,j));
99+
gsl_vector_set (y, i, Yr(i));
100+
}
101+
102+
gsl_multifit_linear_workspace *work = gsl_multifit_linear_alloc (n, k);
103+
gsl_multifit_linear (X, y, c, cov, &chisq, work);
104+
gsl_multifit_linear_free (work);
105+
106+
Rcpp::NumericVector coefr(k), stderrestr(k);
107+
for (i = 0; i < k; i++) {
108+
coefr(i) = gsl_vector_get(c,i);
109+
stderrestr(i) = sqrt(gsl_matrix_get(cov,i,i));
110+
}
111+
gsl_matrix_free (X);
112+
gsl_vector_free (y);
113+
gsl_vector_free (c);
114+
gsl_matrix_free (cov);
115+
116+
117+
return Rcpp::List::create( Rcpp::Named( "coef", coefr),
118+
Rcpp::Named( "stderr", stderrestr));
119+
}')
120+
fun
121+
}

‎inst/examples/functionCallback/newApiExample.r‎

Lines changed: 20 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
#!/usr/bin/env r
22

33
suppressMessages(library(Rcpp))
4-
suppressMessages(library(inline))
54

65
# R function that will be called from C++
76
vecfunc<-function(x) {
@@ -12,6 +11,12 @@ vecfunc <- function(x) {
1211
return(y)
1312
}
1413

14+
## NOTE: This is the old way to compile Rcpp code inline.
15+
## The code here has left as a historical artifact and tribute to the old way.
16+
## Please use the code under the "new" inline compilation section.
17+
18+
suppressMessages(library(inline))
19+
1520
# C++ source code to operate on function and vector
1621
cpp<-'
1722
int n = as<int>(N);
@@ -27,6 +32,20 @@ cpp <- '
2732
funx<- cxxfunction(signature(N="integer" ,xvec="numeric",fun="function" ),
2833
body=cpp,include="using namespace Rcpp;",plugin="Rcpp")
2934

35+
36+
## NOTE: Within this section, the new way to compile Rcpp code inline has been
37+
## written. Please use the code next as a template for your own project.
38+
39+
# C++ source code to operate on function and vector
40+
cppFunction('
41+
NumericVector funx(int n, NumericVector numvec, Function f){
42+
for( int i = 0; i < n; i++ ){
43+
numvec = f( numvec ) ;
44+
}
45+
return numvec ;
46+
}')
47+
48+
3049
# create the vector
3150
xvec<- sqrt(c(1:12,11:1))
3251

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp